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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.994   ! raeburn     4: # $Id: loncommon.pm,v 1.993 2011/01/03 14:19:38 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.793     raeburn   412:     function openstdbrowser(formname,uname,udom,roleflag,ignorefilter,courseadvonly) {
1.74      www       413:         var url = '/adm/pickstudent?';
                    414:         var filter;
1.558     albertel  415: 	if (!ignorefilter) {
                    416: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    417: 	}
1.74      www       418:         if (filter != null) {
                    419:            if (filter != '') {
                    420:                url += 'filter='+filter+'&';
                    421: 	   }
                    422:         }
                    423:         url += 'form=' + formname + '&unameelement='+uname+
                    424:                                     '&udomelement='+udom;
1.111     www       425: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   426:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       427:         var title = 'Student_Browser';
1.74      www       428:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    429:         options += ',width=700,height=600';
                    430:         stdeditbrowser = open(url,title,options,'1');
                    431:         stdeditbrowser.focus();
                    432:     }
1.824     bisitz    433: // ]]>
1.74      www       434: </script>
                    435: ENDSTDBRW
                    436: }
1.42      matthew   437: 
1.74      www       438: sub selectstudent_link {
1.793     raeburn   439:    my ($form,$unameele,$udomele,$courseadvonly)=@_;
                    440:    my $callargs = "'".$form."','".$unameele."','".$udomele."'";
1.258     albertel  441:    if ($env{'request.course.id'}) {  
1.302     albertel  442:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    443: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    444: 					'/'.$env{'request.course.sec'})) {
1.111     www       445: 	   return '';
                    446:        }
1.793     raeburn   447:        if ($courseadvonly)  {
                    448:            $callargs .= ",'',1,1";
                    449:        }
                    450:        return '<span class="LC_nobreak">'.
                    451:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    452:               &mt('Select User').'</a></span>';
1.74      www       453:    }
1.258     albertel  454:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.793     raeburn   455:        $callargs .= ",1"; 
                    456:        return '<span class="LC_nobreak">'.
                    457:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    458:               &mt('Select User').'</a></span>';
1.111     www       459:    }
                    460:    return '';
1.91      www       461: }
                    462: 
1.653     raeburn   463: sub authorbrowser_javascript {
                    464:     return <<"ENDAUTHORBRW";
1.776     bisitz    465: <script type="text/javascript" language="JavaScript">
1.824     bisitz    466: // <![CDATA[
1.653     raeburn   467: var stdeditbrowser;
                    468: 
                    469: function openauthorbrowser(formname,udom) {
                    470:     var url = '/adm/pickauthor?';
                    471:     url += 'form='+formname+'&roledom='+udom;
                    472:     var title = 'Author_Browser';
                    473:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    474:     options += ',width=700,height=600';
                    475:     stdeditbrowser = open(url,title,options,'1');
                    476:     stdeditbrowser.focus();
                    477: }
                    478: 
1.824     bisitz    479: // ]]>
1.653     raeburn   480: </script>
                    481: ENDAUTHORBRW
                    482: }
                    483: 
1.91      www       484: sub coursebrowser_javascript {
1.909     raeburn   485:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype) = @_;
1.932     raeburn   486:     my $wintitle = 'Course_Browser';
1.931     raeburn   487:     if ($crstype eq 'Community') {
1.932     raeburn   488:         $wintitle = 'Community_Browser';
1.909     raeburn   489:     }
1.876     raeburn   490:     my $id_functions = &javascript_index_functions();
                    491:     my $output = '
1.776     bisitz    492: <script type="text/javascript" language="JavaScript">
1.824     bisitz    493: // <![CDATA[
1.468     raeburn   494:     var stdeditbrowser;'."\n";
1.876     raeburn   495: 
                    496:     $output .= <<"ENDSTDBRW";
1.909     raeburn   497:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       498:         var url = '/adm/pickcourse?';
1.895     raeburn   499:         var formid = getFormIdByName(formname);
1.876     raeburn   500:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  501:         if (domainfilter != null) {
                    502:            if (domainfilter != '') {
                    503:                url += 'domainfilter='+domainfilter+'&';
                    504: 	   }
                    505:         }
1.91      www       506:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  507: 	                            '&cdomelement='+udom+
                    508:                                     '&cnameelement='+desc;
1.468     raeburn   509:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   510:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   511:                 url += '&roleelement='+extra_element;
                    512:                 if (domainfilter == null || domainfilter == '') {
                    513:                     url += '&domainfilter='+extra_element;
                    514:                 }
1.234     raeburn   515:             }
1.468     raeburn   516:             else {
                    517:                 if (formname == 'portform') {
                    518:                     url += '&setroles='+extra_element;
1.800     raeburn   519:                 } else {
                    520:                     if (formname == 'rules') {
                    521:                         url += '&fixeddom='+extra_element; 
                    522:                     }
1.468     raeburn   523:                 }
                    524:             }     
1.230     raeburn   525:         }
1.909     raeburn   526:         if (type != null && type != '') {
                    527:             url += '&type='+type;
                    528:         }
                    529:         if (type_elem != null && type_elem != '') {
                    530:             url += '&typeelement='+type_elem;
                    531:         }
1.872     raeburn   532:         if (formname == 'ccrs') {
                    533:             var ownername = document.forms[formid].ccuname.value;
                    534:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
                    535:             url += '&cloner='+ownername+':'+ownerdom;
                    536:         }
1.293     raeburn   537:         if (multflag !=null && multflag != '') {
                    538:             url += '&multiple='+multflag;
                    539:         }
1.909     raeburn   540:         var title = '$wintitle';
1.91      www       541:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    542:         options += ',width=700,height=600';
                    543:         stdeditbrowser = open(url,title,options,'1');
                    544:         stdeditbrowser.focus();
                    545:     }
1.876     raeburn   546: $id_functions
                    547: ENDSTDBRW
1.905     raeburn   548:     if (($sec_element ne '') || ($role_element ne '')) {
                    549:         $output .= &setsec_javascript($sec_element,$formname,$role_element);
1.876     raeburn   550:     }
                    551:     $output .= '
                    552: // ]]>
                    553: </script>';
                    554:     return $output;
                    555: }
                    556: 
                    557: sub javascript_index_functions {
                    558:     return <<"ENDJS";
                    559: 
                    560: function getFormIdByName(formname) {
                    561:     for (var i=0;i<document.forms.length;i++) {
                    562:         if (document.forms[i].name == formname) {
                    563:             return i;
                    564:         }
                    565:     }
                    566:     return -1;
                    567: }
                    568: 
                    569: function getIndexByName(formid,item) {
                    570:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    571:         if (document.forms[formid].elements[i].name == item) {
                    572:             return i;
                    573:         }
                    574:     }
                    575:     return -1;
                    576: }
1.468     raeburn   577: 
1.876     raeburn   578: function getDomainFromSelectbox(formname,udom) {
                    579:     var userdom;
                    580:     var formid = getFormIdByName(formname);
                    581:     if (formid > -1) {
                    582:         var domid = getIndexByName(formid,udom);
                    583:         if (domid > -1) {
                    584:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    585:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    586:             }
                    587:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    588:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   589:             }
                    590:         }
                    591:     }
1.876     raeburn   592:     return userdom;
                    593: }
                    594: 
                    595: ENDJS
1.468     raeburn   596: 
1.876     raeburn   597: }
                    598: 
                    599: sub userbrowser_javascript {
                    600:     my $id_functions = &javascript_index_functions();
                    601:     return <<"ENDUSERBRW";
                    602: 
1.888     raeburn   603: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   604:     var url = '/adm/pickuser?';
                    605:     var userdom = getDomainFromSelectbox(formname,udom);
                    606:     if (userdom != null) {
                    607:        if (userdom != '') {
                    608:            url += 'srchdom='+userdom+'&';
                    609:        }
                    610:     }
                    611:     url += 'form=' + formname + '&unameelement='+uname+
                    612:                                 '&udomelement='+udom+
                    613:                                 '&ulastelement='+ulast+
                    614:                                 '&ufirstelement='+ufirst+
                    615:                                 '&uemailelement='+uemail+
1.881     raeburn   616:                                 '&hideudomelement='+hideudom+
                    617:                                 '&coursedom='+crsdom;
1.888     raeburn   618:     if ((caller != null) && (caller != undefined)) {
                    619:         url += '&caller='+caller;
                    620:     }
1.876     raeburn   621:     var title = 'User_Browser';
                    622:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    623:     options += ',width=700,height=600';
                    624:     var stdeditbrowser = open(url,title,options,'1');
                    625:     stdeditbrowser.focus();
                    626: }
                    627: 
1.888     raeburn   628: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   629:     var formid = getFormIdByName(formname);
                    630:     if (formid > -1) {
1.888     raeburn   631:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   632:         var domid = getIndexByName(formid,udom);
                    633:         var hidedomid = getIndexByName(formid,origdom);
                    634:         if (hidedomid > -1) {
                    635:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   636:             var unameval = document.forms[formid].elements[unameid].value;
                    637:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    638:                 if (domid > -1) {
                    639:                     var slct = document.forms[formid].elements[domid];
                    640:                     if (slct.type == 'select-one') {
                    641:                         var i;
                    642:                         for (i=0;i<slct.length;i++) {
                    643:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    644:                         }
                    645:                     }
                    646:                     if (slct.type == 'hidden') {
                    647:                         slct.value = fixeddom;
1.876     raeburn   648:                     }
                    649:                 }
1.468     raeburn   650:             }
                    651:         }
                    652:     }
1.876     raeburn   653:     return;
                    654: }
                    655: 
                    656: $id_functions
                    657: ENDUSERBRW
1.468     raeburn   658: }
                    659: 
                    660: sub setsec_javascript {
1.905     raeburn   661:     my ($sec_element,$formname,$role_element) = @_;
                    662:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    663:         $communityrolestr);
                    664:     if ($role_element ne '') {
                    665:         my @allroles = ('st','ta','ep','in','ad');
                    666:         foreach my $crstype ('Course','Community') {
                    667:             if ($crstype eq 'Community') {
                    668:                 foreach my $role (@allroles) {
                    669:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    670:                 }
                    671:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    672:             } else {
                    673:                 foreach my $role (@allroles) {
                    674:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    675:                 }
                    676:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    677:             }
                    678:         }
                    679:         $rolestr = '"'.join('","',@allroles).'"';
                    680:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    681:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    682:     }
1.468     raeburn   683:     my $setsections = qq|
                    684: function setSect(sectionlist) {
1.629     raeburn   685:     var sectionsArray = new Array();
                    686:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    687:         sectionsArray = sectionlist.split(",");
                    688:     }
1.468     raeburn   689:     var numSections = sectionsArray.length;
                    690:     document.$formname.$sec_element.length = 0;
                    691:     if (numSections == 0) {
                    692:         document.$formname.$sec_element.multiple=false;
                    693:         document.$formname.$sec_element.size=1;
                    694:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    695:     } else {
                    696:         if (numSections == 1) {
                    697:             document.$formname.$sec_element.multiple=false;
                    698:             document.$formname.$sec_element.size=1;
                    699:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    700:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    701:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    702:         } else {
                    703:             for (var i=0; i<numSections; i++) {
                    704:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    705:             }
                    706:             document.$formname.$sec_element.multiple=true
                    707:             if (numSections < 3) {
                    708:                 document.$formname.$sec_element.size=numSections;
                    709:             } else {
                    710:                 document.$formname.$sec_element.size=3;
                    711:             }
                    712:             document.$formname.$sec_element.options[0].selected = false
                    713:         }
                    714:     }
1.91      www       715: }
1.905     raeburn   716: 
                    717: function setRole(crstype) {
1.468     raeburn   718: |;
1.905     raeburn   719:     if ($role_element eq '') {
                    720:         $setsections .= '    return;
                    721: }
                    722: ';
                    723:     } else {
                    724:         $setsections .= qq|
                    725:     var elementLength = document.$formname.$role_element.length;
                    726:     var allroles = Array($rolestr);
                    727:     var courserolenames = Array($courserolestr);
                    728:     var communityrolenames = Array($communityrolestr);
                    729:     if (elementLength != undefined) {
                    730:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    731:             if (crstype == 'Course') {
                    732:                 return;
                    733:             } else {
                    734:                 allroles[5] = 'co';
                    735:                 for (var i=0; i<6; i++) {
                    736:                     document.$formname.$role_element.options[i].value = allroles[i];
                    737:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    738:                 }
                    739:             }
                    740:         } else {
                    741:             if (crstype == 'Community') {
                    742:                 return;
                    743:             } else {
                    744:                 allroles[5] = 'cc';
                    745:                 for (var i=0; i<6; i++) {
                    746:                     document.$formname.$role_element.options[i].value = allroles[i];
                    747:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    748:                 }
                    749:             }
                    750:         }
                    751:     }
                    752:     return;
                    753: }
                    754: |;
                    755:     }
1.468     raeburn   756:     return $setsections;
                    757: }
                    758: 
1.91      www       759: sub selectcourse_link {
1.909     raeburn   760:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    761:        $typeelement) = @_;
                    762:    my $type = $selecttype;
1.871     raeburn   763:    my $linktext = &mt('Select Course');
                    764:    if ($selecttype eq 'Community') {
1.909     raeburn   765:        $linktext = &mt('Select Community');
1.906     raeburn   766:    } elsif ($selecttype eq 'Course/Community') {
                    767:        $linktext = &mt('Select Course/Community');
1.909     raeburn   768:        $type = '';
1.871     raeburn   769:    }
1.787     bisitz    770:    return '<span class="LC_nobreak">'
                    771:          ."<a href='"
                    772:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    773:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   774:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   775:          ."'>".$linktext.'</a>'
1.787     bisitz    776:          .'</span>';
1.74      www       777: }
1.42      matthew   778: 
1.653     raeburn   779: sub selectauthor_link {
                    780:    my ($form,$udom)=@_;
                    781:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    782:           &mt('Select Author').'</a>';
                    783: }
                    784: 
1.876     raeburn   785: sub selectuser_link {
1.881     raeburn   786:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   787:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   788:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   789:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   790:            ');">'.$linktext.'</a>';
1.876     raeburn   791: }
                    792: 
1.273     raeburn   793: sub check_uncheck_jscript {
                    794:     my $jscript = <<"ENDSCRT";
                    795: function checkAll(field) {
                    796:     if (field.length > 0) {
                    797:         for (i = 0; i < field.length; i++) {
                    798:             field[i].checked = true ;
                    799:         }
                    800:     } else {
                    801:         field.checked = true
                    802:     }
                    803: }
                    804:  
                    805: function uncheckAll(field) {
                    806:     if (field.length > 0) {
                    807:         for (i = 0; i < field.length; i++) {
                    808:             field[i].checked = false ;
1.543     albertel  809:         }
                    810:     } else {
1.273     raeburn   811:         field.checked = false ;
                    812:     }
                    813: }
                    814: ENDSCRT
                    815:     return $jscript;
                    816: }
                    817: 
1.656     www       818: sub select_timezone {
1.659     raeburn   819:    my ($name,$selected,$onchange,$includeempty)=@_;
                    820:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    821:    if ($includeempty) {
                    822:        $output .= '<option value=""';
                    823:        if (($selected eq '') || ($selected eq 'local')) {
                    824:            $output .= ' selected="selected" ';
                    825:        }
                    826:        $output .= '> </option>';
                    827:    }
1.657     raeburn   828:    my @timezones = DateTime::TimeZone->all_names;
                    829:    foreach my $tzone (@timezones) {
                    830:        $output.= '<option value="'.$tzone.'"';
                    831:        if ($tzone eq $selected) {
                    832:            $output.=' selected="selected"';
                    833:        }
                    834:        $output.=">$tzone</option>\n";
1.656     www       835:    }
                    836:    $output.="</select>";
                    837:    return $output;
                    838: }
1.273     raeburn   839: 
1.687     raeburn   840: sub select_datelocale {
                    841:     my ($name,$selected,$onchange,$includeempty)=@_;
                    842:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    843:     if ($includeempty) {
                    844:         $output .= '<option value=""';
                    845:         if ($selected eq '') {
                    846:             $output .= ' selected="selected" ';
                    847:         }
                    848:         $output .= '> </option>';
                    849:     }
                    850:     my (@possibles,%locale_names);
                    851:     my @locales = DateTime::Locale::Catalog::Locales;
                    852:     foreach my $locale (@locales) {
                    853:         if (ref($locale) eq 'HASH') {
                    854:             my $id = $locale->{'id'};
                    855:             if ($id ne '') {
                    856:                 my $en_terr = $locale->{'en_territory'};
                    857:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   858:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   859:                 if (grep(/^en$/,@languages) || !@languages) {
                    860:                     if ($en_terr ne '') {
                    861:                         $locale_names{$id} = '('.$en_terr.')';
                    862:                     } elsif ($native_terr ne '') {
                    863:                         $locale_names{$id} = $native_terr;
                    864:                     }
                    865:                 } else {
                    866:                     if ($native_terr ne '') {
                    867:                         $locale_names{$id} = $native_terr.' ';
                    868:                     } elsif ($en_terr ne '') {
                    869:                         $locale_names{$id} = '('.$en_terr.')';
                    870:                     }
                    871:                 }
                    872:                 push (@possibles,$id);
                    873:             }
                    874:         }
                    875:     }
                    876:     foreach my $item (sort(@possibles)) {
                    877:         $output.= '<option value="'.$item.'"';
                    878:         if ($item eq $selected) {
                    879:             $output.=' selected="selected"';
                    880:         }
                    881:         $output.=">$item";
                    882:         if ($locale_names{$item} ne '') {
                    883:             $output.="  $locale_names{$item}</option>\n";
                    884:         }
                    885:         $output.="</option>\n";
                    886:     }
                    887:     $output.="</select>";
                    888:     return $output;
                    889: }
                    890: 
1.792     raeburn   891: sub select_language {
                    892:     my ($name,$selected,$includeempty) = @_;
                    893:     my %langchoices;
                    894:     if ($includeempty) {
                    895:         %langchoices = ('' => 'No language preference');
                    896:     }
                    897:     foreach my $id (&languageids()) {
                    898:         my $code = &supportedlanguagecode($id);
                    899:         if ($code) {
                    900:             $langchoices{$code} = &plainlanguagedescription($id);
                    901:         }
                    902:     }
1.970     raeburn   903:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn   904: }
                    905: 
1.42      matthew   906: =pod
1.36      matthew   907: 
1.648     raeburn   908: =item * &linked_select_forms(...)
1.36      matthew   909: 
                    910: linked_select_forms returns a string containing a <script></script> block
                    911: and html for two <select> menus.  The select menus will be linked in that
                    912: changing the value of the first menu will result in new values being placed
                    913: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn   914: order unless a defined order is provided.
1.36      matthew   915: 
                    916: linked_select_forms takes the following ordered inputs:
                    917: 
                    918: =over 4
                    919: 
1.112     bowersj2  920: =item * $formname, the name of the <form> tag
1.36      matthew   921: 
1.112     bowersj2  922: =item * $middletext, the text which appears between the <select> tags
1.36      matthew   923: 
1.112     bowersj2  924: =item * $firstdefault, the default value for the first menu
1.36      matthew   925: 
1.112     bowersj2  926: =item * $firstselectname, the name of the first <select> tag
1.36      matthew   927: 
1.112     bowersj2  928: =item * $secondselectname, the name of the second <select> tag
1.36      matthew   929: 
1.112     bowersj2  930: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew   931: 
1.609     raeburn   932: =item * $menuorder, the order of values in the first menu
                    933: 
1.41      ng        934: =back 
                    935: 
1.36      matthew   936: Below is an example of such a hash.  Only the 'text', 'default', and 
                    937: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                    938: values for the first select menu.  The text that coincides with the 
1.41      ng        939: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew   940: and text for the second menu are given in the hash pointed to by 
                    941: $menu{$choice1}->{'select2'}.  
                    942: 
1.112     bowersj2  943:  my %menu = ( A1 => { text =>"Choice A1" ,
                    944:                        default => "B3",
                    945:                        select2 => { 
                    946:                            B1 => "Choice B1",
                    947:                            B2 => "Choice B2",
                    948:                            B3 => "Choice B3",
                    949:                            B4 => "Choice B4"
1.609     raeburn   950:                            },
                    951:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2  952:                    },
                    953:                A2 => { text =>"Choice A2" ,
                    954:                        default => "C2",
                    955:                        select2 => { 
                    956:                            C1 => "Choice C1",
                    957:                            C2 => "Choice C2",
                    958:                            C3 => "Choice C3"
1.609     raeburn   959:                            },
                    960:                        order => ['C2','C1','C3'],
1.112     bowersj2  961:                    },
                    962:                A3 => { text =>"Choice A3" ,
                    963:                        default => "D6",
                    964:                        select2 => { 
                    965:                            D1 => "Choice D1",
                    966:                            D2 => "Choice D2",
                    967:                            D3 => "Choice D3",
                    968:                            D4 => "Choice D4",
                    969:                            D5 => "Choice D5",
                    970:                            D6 => "Choice D6",
                    971:                            D7 => "Choice D7"
1.609     raeburn   972:                            },
                    973:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2  974:                    }
                    975:                );
1.36      matthew   976: 
                    977: =cut
                    978: 
                    979: sub linked_select_forms {
                    980:     my ($formname,
                    981:         $middletext,
                    982:         $firstdefault,
                    983:         $firstselectname,
                    984:         $secondselectname, 
1.609     raeburn   985:         $hashref,
                    986:         $menuorder,
1.36      matthew   987:         ) = @_;
                    988:     my $second = "document.$formname.$secondselectname";
                    989:     my $first = "document.$formname.$firstselectname";
                    990:     # output the javascript to do the changing
                    991:     my $result = '';
1.776     bisitz    992:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz    993:     $result.="// <![CDATA[\n";
1.36      matthew   994:     $result.="var select2data = new Object();\n";
                    995:     $" = '","';
                    996:     my $debug = '';
                    997:     foreach my $s1 (sort(keys(%$hashref))) {
                    998:         $result.="select2data.d_$s1 = new Object();\n";        
                    999:         $result.="select2data.d_$s1.def = new String('".
                   1000:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1001:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1002:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1003:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1004:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1005:         }
1.36      matthew  1006:         $result.="\"@s2values\");\n";
                   1007:         $result.="select2data.d_$s1.texts = new Array(";        
                   1008:         my @s2texts;
                   1009:         foreach my $value (@s2values) {
                   1010:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1011:         }
                   1012:         $result.="\"@s2texts\");\n";
                   1013:     }
                   1014:     $"=' ';
                   1015:     $result.= <<"END";
                   1016: 
                   1017: function select1_changed() {
                   1018:     // Determine new choice
                   1019:     var newvalue = "d_" + $first.value;
                   1020:     // update select2
                   1021:     var values     = select2data[newvalue].values;
                   1022:     var texts      = select2data[newvalue].texts;
                   1023:     var select2def = select2data[newvalue].def;
                   1024:     var i;
                   1025:     // out with the old
                   1026:     for (i = 0; i < $second.options.length; i++) {
                   1027:         $second.options[i] = null;
                   1028:     }
                   1029:     // in with the nuclear
                   1030:     for (i=0;i<values.length; i++) {
                   1031:         $second.options[i] = new Option(values[i]);
1.143     matthew  1032:         $second.options[i].value = values[i];
1.36      matthew  1033:         $second.options[i].text = texts[i];
                   1034:         if (values[i] == select2def) {
                   1035:             $second.options[i].selected = true;
                   1036:         }
                   1037:     }
                   1038: }
1.824     bisitz   1039: // ]]>
1.36      matthew  1040: </script>
                   1041: END
                   1042:     # output the initial values for the selection lists
                   1043:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609     raeburn  1044:     my @order = sort(keys(%{$hashref}));
                   1045:     if (ref($menuorder) eq 'ARRAY') {
                   1046:         @order = @{$menuorder};
                   1047:     }
                   1048:     foreach my $value (@order) {
1.36      matthew  1049:         $result.="    <option value=\"$value\" ";
1.253     albertel 1050:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1051:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1052:     }
                   1053:     $result .= "</select>\n";
                   1054:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1055:     $result .= $middletext;
                   1056:     $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
                   1057:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1058:     
                   1059:     my @secondorder = sort(keys(%select2));
                   1060:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1061:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1062:     }
                   1063:     foreach my $value (@secondorder) {
1.36      matthew  1064:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1065:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1066:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1067:     }
                   1068:     $result .= "</select>\n";
                   1069:     #    return $debug;
                   1070:     return $result;
                   1071: }   #  end of sub linked_select_forms {
                   1072: 
1.45      matthew  1073: =pod
1.44      bowersj2 1074: 
1.973     raeburn  1075: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1076: 
1.112     bowersj2 1077: Returns a string corresponding to an HTML link to the given help
                   1078: $topic, where $topic corresponds to the name of a .tex file in
                   1079: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1080: spaces. 
                   1081: 
                   1082: $text will optionally be linked to the same topic, allowing you to
                   1083: link text in addition to the graphic. If you do not want to link
                   1084: text, but wish to specify one of the later parameters, pass an
                   1085: empty string. 
                   1086: 
                   1087: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1088: the link will not open a new window. If false, the link will open
                   1089: a new window using Javascript. (Default is false.) 
                   1090: 
                   1091: $width and $height are optional numerical parameters that will
                   1092: override the width and height of the popped up window, which may
1.973     raeburn  1093: be useful for certain help topics with big pictures included.
                   1094: 
                   1095: $imgid is the id of the img tag used for the help icon. This may be
                   1096: used in a javascript call to switch the image src.  See 
                   1097: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1098: 
                   1099: =cut
                   1100: 
                   1101: sub help_open_topic {
1.973     raeburn  1102:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1103:     $text = "" if (not defined $text);
1.44      bowersj2 1104:     $stayOnPage = 0 if (not defined $stayOnPage);
                   1105:     $width = 350 if (not defined $width);
                   1106:     $height = 400 if (not defined $height);
                   1107:     my $filename = $topic;
                   1108:     $filename =~ s/ /_/g;
                   1109: 
1.48      bowersj2 1110:     my $template = "";
                   1111:     my $link;
1.572     banghart 1112:     
1.159     www      1113:     $topic=~s/\W/\_/g;
1.44      bowersj2 1114: 
1.572     banghart 1115:     if (!$stayOnPage) {
1.72      bowersj2 1116: 	$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 1117:     } else {
1.48      bowersj2 1118: 	$link = "/adm/help/${filename}.hlp";
                   1119:     }
                   1120: 
                   1121:     # Add the text
1.755     neumanie 1122:     if ($text ne "") {	
1.763     bisitz   1123: 	$template.='<span class="LC_help_open_topic">'
                   1124:                   .'<a target="_top" href="'.$link.'">'
                   1125:                   .$text.'</a>';
1.48      bowersj2 1126:     }
                   1127: 
1.763     bisitz   1128:     # (Always) Add the graphic
1.179     matthew  1129:     my $title = &mt('Online Help');
1.667     raeburn  1130:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1131:     if ($imgid ne '') {
                   1132:         $imgid = ' id="'.$imgid.'"';
                   1133:     }
1.763     bisitz   1134:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1135:               .'<img src="'.$helpicon.'" border="0"'
                   1136:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1137:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1138:               .' /></a>';
                   1139:     if ($text ne "") {	
                   1140:         $template.='</span>';
                   1141:     }
1.44      bowersj2 1142:     return $template;
                   1143: 
1.106     bowersj2 1144: }
                   1145: 
                   1146: # This is a quicky function for Latex cheatsheet editing, since it 
                   1147: # appears in at least four places
                   1148: sub helpLatexCheatsheet {
1.732     raeburn  1149:     my ($topic,$text,$not_author) = @_;
                   1150:     my $out;
1.106     bowersj2 1151:     my $addOther = '';
1.732     raeburn  1152:     if ($topic) {
1.763     bisitz   1153: 	$addOther = '<span>'.&Apache::loncommon::help_open_topic($topic,&mt($text),
                   1154: 							       undef, undef, 600).
                   1155: 								   '</span> ';
                   1156:     }
                   1157:     $out = '<span>' # Start cheatsheet
                   1158: 	  .$addOther
                   1159:           .'<span>'
                   1160: 	  .&Apache::loncommon::help_open_topic('Greek_Symbols',&mt('Greek Symbols'),
                   1161: 					       undef,undef,600)
                   1162: 	  .'</span> <span>'
                   1163: 	  .&Apache::loncommon::help_open_topic('Other_Symbols',&mt('Other Symbols'),
                   1164: 					       undef,undef,600)
                   1165: 	  .'</span>';
1.732     raeburn  1166:     unless ($not_author) {
1.763     bisitz   1167:         $out .= ' <span>'
                   1168: 	       .&Apache::loncommon::help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),
                   1169: 	                                            undef,undef,600)
                   1170: 	       .'</span>';
1.732     raeburn  1171:     }
1.763     bisitz   1172:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1173:     return $out;
1.172     www      1174: }
                   1175: 
1.430     albertel 1176: sub general_help {
                   1177:     my $helptopic='Student_Intro';
                   1178:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1179: 	$helptopic='Authoring_Intro';
1.907     raeburn  1180:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1181: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1182:     } elsif ($env{'request.role'}=~/^dc/) {
                   1183:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1184:     }
                   1185:     return $helptopic;
                   1186: }
                   1187: 
                   1188: sub update_help_link {
                   1189:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1190:     my $origurl = $ENV{'REQUEST_URI'};
                   1191:     $origurl=~s|^/~|/priv/|;
                   1192:     my $timestamp = time;
                   1193:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1194:         $$datum = &escape($$datum);
                   1195:     }
                   1196: 
                   1197:     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";
                   1198:     my $output .= <<"ENDOUTPUT";
                   1199: <script type="text/javascript">
1.824     bisitz   1200: // <![CDATA[
1.430     albertel 1201: banner_link = '$banner_link';
1.824     bisitz   1202: // ]]>
1.430     albertel 1203: </script>
                   1204: ENDOUTPUT
                   1205:     return $output;
                   1206: }
                   1207: 
                   1208: # now just updates the help link and generates a blue icon
1.193     raeburn  1209: sub help_open_menu {
1.430     albertel 1210:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1211: 	= @_;    
1.949     droeschl 1212:     $stayOnPage = 1;
1.430     albertel 1213:     my $output;
                   1214:     if ($component_help) {
                   1215: 	if (!$text) {
                   1216: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1217: 				       $width,$height);
                   1218: 	} else {
                   1219: 	    my $help_text;
                   1220: 	    $help_text=&unescape($topic);
                   1221: 	    $output='<table><tr><td>'.
                   1222: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1223: 				 $width,$height).'</td></tr></table>';
                   1224: 	}
                   1225:     }
                   1226:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1227:     return $output.$banner_link;
                   1228: }
                   1229: 
                   1230: sub top_nav_help {
                   1231:     my ($text) = @_;
1.436     albertel 1232:     $text = &mt($text);
1.949     droeschl 1233:     my $stay_on_page = 1;
                   1234: 
1.572     banghart 1235:     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436     albertel 1236: 	                     : "javascript:helpMenu('open')";
1.572     banghart 1237:     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436     albertel 1238: 
1.201     raeburn  1239:     my $title = &mt('Get help');
1.436     albertel 1240: 
                   1241:     return <<"END";
                   1242: $banner_link
                   1243:  <a href="$link" title="$title">$text</a>
                   1244: END
                   1245: }
                   1246: 
                   1247: sub help_menu_js {
                   1248:     my ($text) = @_;
1.949     droeschl 1249:     my $stayOnPage = 1;
1.436     albertel 1250:     my $width = 620;
                   1251:     my $height = 600;
1.430     albertel 1252:     my $helptopic=&general_help();
                   1253:     my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1254:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1255:     my $start_page =
                   1256:         &Apache::loncommon::start_page('Help Menu', undef,
                   1257: 				       {'frameset'    => 1,
                   1258: 					'js_ready'    => 1,
                   1259: 					'add_entries' => {
                   1260: 					    'border' => '0',
1.579     raeburn  1261: 					    'rows'   => "110,*",},});
1.331     albertel 1262:     my $end_page =
                   1263:         &Apache::loncommon::end_page({'frameset' => 1,
                   1264: 				      'js_ready' => 1,});
                   1265: 
1.436     albertel 1266:     my $template .= <<"ENDTEMPLATE";
                   1267: <script type="text/javascript">
1.877     bisitz   1268: // <![CDATA[
1.253     albertel 1269: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1270: var banner_link = '';
1.243     raeburn  1271: function helpMenu(target) {
                   1272:     var caller = this;
                   1273:     if (target == 'open') {
                   1274:         var newWindow = null;
                   1275:         try {
1.262     albertel 1276:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1277:         }
                   1278:         catch(error) {
                   1279:             writeHelp(caller);
                   1280:             return;
                   1281:         }
                   1282:         if (newWindow) {
                   1283:             caller = newWindow;
                   1284:         }
1.193     raeburn  1285:     }
1.243     raeburn  1286:     writeHelp(caller);
                   1287:     return;
                   1288: }
                   1289: function writeHelp(caller) {
1.430     albertel 1290:     caller.document.writeln('$start_page<frame name="bannerframe"  src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')
1.243     raeburn  1291:     caller.document.close()
                   1292:     caller.focus()
1.193     raeburn  1293: }
1.877     bisitz   1294: // END LON-CAPA Internal -->
1.253     albertel 1295: // ]]>
1.436     albertel 1296: </script>
1.193     raeburn  1297: ENDTEMPLATE
                   1298:     return $template;
                   1299: }
                   1300: 
1.172     www      1301: sub help_open_bug {
                   1302:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1303:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1304:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1305:     $text = "" if (not defined $text);
                   1306: 	$stayOnPage=1;
1.184     albertel 1307:     $width = 600 if (not defined $width);
                   1308:     $height = 600 if (not defined $height);
1.172     www      1309: 
                   1310:     $topic=~s/\W+/\+/g;
                   1311:     my $link='';
                   1312:     my $template='';
1.379     albertel 1313:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1314: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1315:     if (!$stayOnPage)
                   1316:     {
                   1317: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1318:     }
                   1319:     else
                   1320:     {
                   1321: 	$link = $url;
                   1322:     }
                   1323:     # Add the text
                   1324:     if ($text ne "")
                   1325:     {
                   1326: 	$template .= 
                   1327:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1328:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1329:     }
                   1330: 
                   1331:     # Add the graphic
1.179     matthew  1332:     my $title = &mt('Report a Bug');
1.215     albertel 1333:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1334:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1335:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1336: ENDTEMPLATE
                   1337:     if ($text ne '') { $template.='</td></tr></table>' };
                   1338:     return $template;
                   1339: 
                   1340: }
                   1341: 
                   1342: sub help_open_faq {
                   1343:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1344:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1345:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1346:     $text = "" if (not defined $text);
                   1347: 	$stayOnPage=1;
                   1348:     $width = 350 if (not defined $width);
                   1349:     $height = 400 if (not defined $height);
                   1350: 
                   1351:     $topic=~s/\W+/\+/g;
                   1352:     my $link='';
                   1353:     my $template='';
                   1354:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1355:     if (!$stayOnPage)
                   1356:     {
                   1357: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1358:     }
                   1359:     else
                   1360:     {
                   1361: 	$link = $url;
                   1362:     }
                   1363: 
                   1364:     # Add the text
                   1365:     if ($text ne "")
                   1366:     {
                   1367: 	$template .= 
1.173     www      1368:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1369:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1370:     }
                   1371: 
                   1372:     # Add the graphic
1.179     matthew  1373:     my $title = &mt('View the FAQ');
1.215     albertel 1374:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1375:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1376:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1377: ENDTEMPLATE
                   1378:     if ($text ne '') { $template.='</td></tr></table>' };
                   1379:     return $template;
                   1380: 
1.44      bowersj2 1381: }
1.37      matthew  1382: 
1.180     matthew  1383: ###############################################################
                   1384: ###############################################################
                   1385: 
1.45      matthew  1386: =pod
                   1387: 
1.648     raeburn  1388: =item * &change_content_javascript():
1.256     matthew  1389: 
                   1390: This and the next function allow you to create small sections of an
                   1391: otherwise static HTML page that you can update on the fly with
                   1392: Javascript, even in Netscape 4.
                   1393: 
                   1394: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1395: must be written to the HTML page once. It will prove the Javascript
                   1396: function "change(name, content)". Calling the change function with the
                   1397: name of the section 
                   1398: you want to update, matching the name passed to C<changable_area>, and
                   1399: the new content you want to put in there, will put the content into
                   1400: that area.
                   1401: 
                   1402: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1403: to contain room for the original contents. You need to "make space"
                   1404: for whatever changes you wish to make, and be B<sure> to check your
                   1405: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1406: it's adequate for updating a one-line status display, but little more.
                   1407: This script will set the space to 100% width, so you only need to
                   1408: worry about height in Netscape 4.
                   1409: 
                   1410: Modern browsers are much less limiting, and if you can commit to the
                   1411: user not using Netscape 4, this feature may be used freely with
                   1412: pretty much any HTML.
                   1413: 
                   1414: =cut
                   1415: 
                   1416: sub change_content_javascript {
                   1417:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1418:     if ($env{'browser.type'} eq 'netscape' &&
                   1419: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1420: 	return (<<NETSCAPE4);
                   1421: 	function change(name, content) {
                   1422: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1423: 	    doc.open();
                   1424: 	    doc.write(content);
                   1425: 	    doc.close();
                   1426: 	}
                   1427: NETSCAPE4
                   1428:     } else {
                   1429: 	# Otherwise, we need to use semi-standards-compliant code
                   1430: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1431: 	# is really scary, and every useful browser supports it
                   1432: 	return (<<DOMBASED);
                   1433: 	function change(name, content) {
                   1434: 	    element = document.getElementById(name);
                   1435: 	    element.innerHTML = content;
                   1436: 	}
                   1437: DOMBASED
                   1438:     }
                   1439: }
                   1440: 
                   1441: =pod
                   1442: 
1.648     raeburn  1443: =item * &changable_area($name,$origContent):
1.256     matthew  1444: 
                   1445: This provides a "changable area" that can be modified on the fly via
                   1446: the Javascript code provided in C<change_content_javascript>. $name is
                   1447: the name you will use to reference the area later; do not repeat the
                   1448: same name on a given HTML page more then once. $origContent is what
                   1449: the area will originally contain, which can be left blank.
                   1450: 
                   1451: =cut
                   1452: 
                   1453: sub changable_area {
                   1454:     my ($name, $origContent) = @_;
                   1455: 
1.258     albertel 1456:     if ($env{'browser.type'} eq 'netscape' &&
                   1457: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1458: 	# If this is netscape 4, we need to use the Layer tag
                   1459: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1460:     } else {
                   1461: 	return "<span id='$name'>$origContent</span>";
                   1462:     }
                   1463: }
                   1464: 
                   1465: =pod
                   1466: 
1.648     raeburn  1467: =item * &viewport_geometry_js 
1.590     raeburn  1468: 
                   1469: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1470: 
                   1471: =cut
                   1472: 
                   1473: 
                   1474: sub viewport_geometry_js { 
                   1475:     return <<"GEOMETRY";
                   1476: var Geometry = {};
                   1477: function init_geometry() {
                   1478:     if (Geometry.init) { return };
                   1479:     Geometry.init=1;
                   1480:     if (window.innerHeight) {
                   1481:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1482:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1483:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1484:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1485:     }
                   1486:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1487:         Geometry.getViewportHeight =
                   1488:             function() { return document.documentElement.clientHeight; };
                   1489:         Geometry.getViewportWidth =
                   1490:             function() { return document.documentElement.clientWidth; };
                   1491: 
                   1492:         Geometry.getHorizontalScroll =
                   1493:             function() { return document.documentElement.scrollLeft; };
                   1494:         Geometry.getVerticalScroll =
                   1495:             function() { return document.documentElement.scrollTop; };
                   1496:     }
                   1497:     else if (document.body.clientHeight) {
                   1498:         Geometry.getViewportHeight =
                   1499:             function() { return document.body.clientHeight; };
                   1500:         Geometry.getViewportWidth =
                   1501:             function() { return document.body.clientWidth; };
                   1502:         Geometry.getHorizontalScroll =
                   1503:             function() { return document.body.scrollLeft; };
                   1504:         Geometry.getVerticalScroll =
                   1505:             function() { return document.body.scrollTop; };
                   1506:     }
                   1507: }
                   1508: 
                   1509: GEOMETRY
                   1510: }
                   1511: 
                   1512: =pod
                   1513: 
1.648     raeburn  1514: =item * &viewport_size_js()
1.590     raeburn  1515: 
                   1516: 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. 
                   1517: 
                   1518: =cut
                   1519: 
                   1520: sub viewport_size_js {
                   1521:     my $geometry = &viewport_geometry_js();
                   1522:     return <<"DIMS";
                   1523: 
                   1524: $geometry
                   1525: 
                   1526: function getViewportDims(width,height) {
                   1527:     init_geometry();
                   1528:     width.value = Geometry.getViewportWidth();
                   1529:     height.value = Geometry.getViewportHeight();
                   1530:     return;
                   1531: }
                   1532: 
                   1533: DIMS
                   1534: }
                   1535: 
                   1536: =pod
                   1537: 
1.648     raeburn  1538: =item * &resize_textarea_js()
1.565     albertel 1539: 
                   1540: emits the needed javascript to resize a textarea to be as big as possible
                   1541: 
                   1542: creates a function resize_textrea that takes two IDs first should be
                   1543: the id of the element to resize, second should be the id of a div that
                   1544: surrounds everything that comes after the textarea, this routine needs
                   1545: to be attached to the <body> for the onload and onresize events.
                   1546: 
1.648     raeburn  1547: =back
1.565     albertel 1548: 
                   1549: =cut
                   1550: 
                   1551: sub resize_textarea_js {
1.590     raeburn  1552:     my $geometry = &viewport_geometry_js();
1.565     albertel 1553:     return <<"RESIZE";
                   1554:     <script type="text/javascript">
1.824     bisitz   1555: // <![CDATA[
1.590     raeburn  1556: $geometry
1.565     albertel 1557: 
1.588     albertel 1558: function getX(element) {
                   1559:     var x = 0;
                   1560:     while (element) {
                   1561: 	x += element.offsetLeft;
                   1562: 	element = element.offsetParent;
                   1563:     }
                   1564:     return x;
                   1565: }
                   1566: function getY(element) {
                   1567:     var y = 0;
                   1568:     while (element) {
                   1569: 	y += element.offsetTop;
                   1570: 	element = element.offsetParent;
                   1571:     }
                   1572:     return y;
                   1573: }
                   1574: 
                   1575: 
1.565     albertel 1576: function resize_textarea(textarea_id,bottom_id) {
                   1577:     init_geometry();
                   1578:     var textarea        = document.getElementById(textarea_id);
                   1579:     //alert(textarea);
                   1580: 
1.588     albertel 1581:     var textarea_top    = getY(textarea);
1.565     albertel 1582:     var textarea_height = textarea.offsetHeight;
                   1583:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1584:     var bottom_top      = getY(bottom);
1.565     albertel 1585:     var bottom_height   = bottom.offsetHeight;
                   1586:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1587:     var fudge           = 23;
1.565     albertel 1588:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1589:     if (new_height < 300) {
                   1590: 	new_height = 300;
                   1591:     }
                   1592:     textarea.style.height=new_height+'px';
                   1593: }
1.824     bisitz   1594: // ]]>
1.565     albertel 1595: </script>
                   1596: RESIZE
                   1597: 
                   1598: }
                   1599: 
                   1600: =pod
                   1601: 
1.256     matthew  1602: =head1 Excel and CSV file utility routines
                   1603: 
                   1604: =over 4
                   1605: 
                   1606: =cut
                   1607: 
                   1608: ###############################################################
                   1609: ###############################################################
                   1610: 
                   1611: =pod
                   1612: 
1.648     raeburn  1613: =item * &csv_translate($text) 
1.37      matthew  1614: 
1.185     www      1615: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1616: format.
                   1617: 
                   1618: =cut
                   1619: 
1.180     matthew  1620: ###############################################################
                   1621: ###############################################################
1.37      matthew  1622: sub csv_translate {
                   1623:     my $text = shift;
                   1624:     $text =~ s/\"/\"\"/g;
1.209     albertel 1625:     $text =~ s/\n/ /g;
1.37      matthew  1626:     return $text;
                   1627: }
1.180     matthew  1628: 
                   1629: ###############################################################
                   1630: ###############################################################
                   1631: 
                   1632: =pod
                   1633: 
1.648     raeburn  1634: =item * &define_excel_formats()
1.180     matthew  1635: 
                   1636: Define some commonly used Excel cell formats.
                   1637: 
                   1638: Currently supported formats:
                   1639: 
                   1640: =over 4
                   1641: 
                   1642: =item header
                   1643: 
                   1644: =item bold
                   1645: 
                   1646: =item h1
                   1647: 
                   1648: =item h2
                   1649: 
                   1650: =item h3
                   1651: 
1.256     matthew  1652: =item h4
                   1653: 
                   1654: =item i
                   1655: 
1.180     matthew  1656: =item date
                   1657: 
                   1658: =back
                   1659: 
                   1660: Inputs: $workbook
                   1661: 
                   1662: Returns: $format, a hash reference.
                   1663: 
                   1664: =cut
                   1665: 
                   1666: ###############################################################
                   1667: ###############################################################
                   1668: sub define_excel_formats {
                   1669:     my ($workbook) = @_;
                   1670:     my $format;
                   1671:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1672:                                                 bottom    => 1,
                   1673:                                                 align     => 'center');
                   1674:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1675:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1676:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1677:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1678:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1679:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1680:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1681:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1682:     return $format;
                   1683: }
                   1684: 
                   1685: ###############################################################
                   1686: ###############################################################
1.113     bowersj2 1687: 
                   1688: =pod
                   1689: 
1.648     raeburn  1690: =item * &create_workbook()
1.255     matthew  1691: 
                   1692: Create an Excel worksheet.  If it fails, output message on the
                   1693: request object and return undefs.
                   1694: 
                   1695: Inputs: Apache request object
                   1696: 
                   1697: Returns (undef) on failure, 
                   1698:     Excel worksheet object, scalar with filename, and formats 
                   1699:     from &Apache::loncommon::define_excel_formats on success
                   1700: 
                   1701: =cut
                   1702: 
                   1703: ###############################################################
                   1704: ###############################################################
                   1705: sub create_workbook {
                   1706:     my ($r) = @_;
                   1707:         #
                   1708:     # Create the excel spreadsheet
                   1709:     my $filename = '/prtspool/'.
1.258     albertel 1710:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1711:         time.'_'.rand(1000000000).'.xls';
                   1712:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1713:     if (! defined($workbook)) {
                   1714:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1715:         $r->print(
                   1716:             '<p class="LC_error">'
                   1717:            .&mt('Problems occurred in creating the new Excel file.')
                   1718:            .' '.&mt('This error has been logged.')
                   1719:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1720:            .'</p>'
                   1721:         );
1.255     matthew  1722:         return (undef);
                   1723:     }
                   1724:     #
                   1725:     $workbook->set_tempdir('/home/httpd/perl/tmp');
                   1726:     #
                   1727:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1728:     return ($workbook,$filename,$format);
                   1729: }
                   1730: 
                   1731: ###############################################################
                   1732: ###############################################################
                   1733: 
                   1734: =pod
                   1735: 
1.648     raeburn  1736: =item * &create_text_file()
1.113     bowersj2 1737: 
1.542     raeburn  1738: Create a file to write to and eventually make available to the user.
1.256     matthew  1739: If file creation fails, outputs an error message on the request object and 
                   1740: return undefs.
1.113     bowersj2 1741: 
1.256     matthew  1742: Inputs: Apache request object, and file suffix
1.113     bowersj2 1743: 
1.256     matthew  1744: Returns (undef) on failure, 
                   1745:     Filehandle and filename on success.
1.113     bowersj2 1746: 
                   1747: =cut
                   1748: 
1.256     matthew  1749: ###############################################################
                   1750: ###############################################################
                   1751: sub create_text_file {
                   1752:     my ($r,$suffix) = @_;
                   1753:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1754:     my $fh;
                   1755:     my $filename = '/prtspool/'.
1.258     albertel 1756:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1757:         time.'_'.rand(1000000000).'.'.$suffix;
                   1758:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1759:     if (! defined($fh)) {
                   1760:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1761:         $r->print(
                   1762:             '<p class="LC_error">'
                   1763:            .&mt('Problems occurred in creating the output file.')
                   1764:            .' '.&mt('This error has been logged.')
                   1765:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1766:            .'</p>'
                   1767:         );
1.113     bowersj2 1768:     }
1.256     matthew  1769:     return ($fh,$filename)
1.113     bowersj2 1770: }
                   1771: 
                   1772: 
1.256     matthew  1773: =pod 
1.113     bowersj2 1774: 
                   1775: =back
                   1776: 
                   1777: =cut
1.37      matthew  1778: 
                   1779: ###############################################################
1.33      matthew  1780: ##        Home server <option> list generating code          ##
                   1781: ###############################################################
1.35      matthew  1782: 
1.169     www      1783: # ------------------------------------------
                   1784: 
                   1785: sub domain_select {
                   1786:     my ($name,$value,$multiple)=@_;
                   1787:     my %domains=map { 
1.514     albertel 1788: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1789:     } &Apache::lonnet::all_domains();
1.169     www      1790:     if ($multiple) {
                   1791: 	$domains{''}=&mt('Any domain');
1.550     albertel 1792: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1793: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1794:     } else {
1.550     albertel 1795: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1796: 	return &select_form($name,$value,\%domains);
1.169     www      1797:     }
                   1798: }
                   1799: 
1.282     albertel 1800: #-------------------------------------------
                   1801: 
                   1802: =pod
                   1803: 
1.519     raeburn  1804: =head1 Routines for form select boxes
                   1805: 
                   1806: =over 4
                   1807: 
1.648     raeburn  1808: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1809: 
                   1810: Returns a string containing a <select> element int multiple mode
                   1811: 
                   1812: 
                   1813: Args:
                   1814:   $name - name of the <select> element
1.506     raeburn  1815:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1816:   $size - number of rows long the select element is
1.283     albertel 1817:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1818:           (shown text should already have been &mt())
1.506     raeburn  1819:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1820: 
1.282     albertel 1821: =cut
                   1822: 
                   1823: #-------------------------------------------
1.169     www      1824: sub multiple_select_form {
1.284     albertel 1825:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1826:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1827:     my $output='';
1.191     matthew  1828:     if (! defined($size)) {
                   1829:         $size = 4;
1.283     albertel 1830:         if (scalar(keys(%$hash))<4) {
                   1831:             $size = scalar(keys(%$hash));
1.191     matthew  1832:         }
                   1833:     }
1.734     bisitz   1834:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1835:     my @order;
1.506     raeburn  1836:     if (ref($order) eq 'ARRAY')  {
                   1837:         @order = @{$order};
                   1838:     } else {
                   1839:         @order = sort(keys(%$hash));
1.501     banghart 1840:     }
                   1841:     if (exists($$hash{'select_form_order'})) {
                   1842:         @order = @{$$hash{'select_form_order'}};
                   1843:     }
                   1844:         
1.284     albertel 1845:     foreach my $key (@order) {
1.356     albertel 1846:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1847:         $output.='selected="selected" ' if ($selected{$key});
                   1848:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1849:     }
                   1850:     $output.="</select>\n";
                   1851:     return $output;
                   1852: }
                   1853: 
1.88      www      1854: #-------------------------------------------
                   1855: 
                   1856: =pod
                   1857: 
1.970     raeburn  1858: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      1859: 
                   1860: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  1861: allow a user to select options from a ref to a hash containing:
                   1862: option_name => displayed text. An optional $onchange can include
                   1863: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   1864: 
1.88      www      1865: See lonrights.pm for an example invocation and use.
                   1866: 
                   1867: =cut
                   1868: 
                   1869: #-------------------------------------------
                   1870: sub select_form {
1.970     raeburn  1871:     my ($def,$name,$hashref,$onchange) = @_;
                   1872:     return unless (ref($hashref) eq 'HASH');
                   1873:     if ($onchange) {
                   1874:         $onchange = ' onchange="'.$onchange.'"';
                   1875:     }
                   1876:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 1877:     my @keys;
1.970     raeburn  1878:     if (exists($hashref->{'select_form_order'})) {
                   1879: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 1880:     } else {
1.970     raeburn  1881: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 1882:     }
1.356     albertel 1883:     foreach my $key (@keys) {
                   1884:         $selectform.=
                   1885: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   1886:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  1887:                 ">".$hashref->{$key}."</option>\n";
1.88      www      1888:     }
                   1889:     $selectform.="</select>";
                   1890:     return $selectform;
                   1891: }
                   1892: 
1.475     www      1893: # For display filters
                   1894: 
                   1895: sub display_filter {
                   1896:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      1897:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.714     bisitz   1898:     return '<span class="LC_nobreak"><label>'.&mt('Records [_1]',
1.475     www      1899: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   1900: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   1901: 	   '</label></span> <span class="LC_nobreak">'.
1.475     www      1902:            &mt('Filter [_1]',
1.477     www      1903: 	   &select_form($env{'form.displayfilter'},
                   1904: 			'displayfilter',
1.970     raeburn  1905: 			{'currentfolder' => 'Current folder/page',
1.477     www      1906: 			 'containing' => 'Containing phrase',
1.970     raeburn  1907: 			 'none' => 'None'})).
1.714     bisitz   1908: 			 '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';
1.475     www      1909: }
                   1910: 
1.167     www      1911: sub gradeleveldescription {
                   1912:     my $gradelevel=shift;
                   1913:     my %gradelevels=(0 => 'Not specified',
                   1914: 		     1 => 'Grade 1',
                   1915: 		     2 => 'Grade 2',
                   1916: 		     3 => 'Grade 3',
                   1917: 		     4 => 'Grade 4',
                   1918: 		     5 => 'Grade 5',
                   1919: 		     6 => 'Grade 6',
                   1920: 		     7 => 'Grade 7',
                   1921: 		     8 => 'Grade 8',
                   1922: 		     9 => 'Grade 9',
                   1923: 		     10 => 'Grade 10',
                   1924: 		     11 => 'Grade 11',
                   1925: 		     12 => 'Grade 12',
                   1926: 		     13 => 'Grade 13',
                   1927: 		     14 => '100 Level',
                   1928: 		     15 => '200 Level',
                   1929: 		     16 => '300 Level',
                   1930: 		     17 => '400 Level',
                   1931: 		     18 => 'Graduate Level');
                   1932:     return &mt($gradelevels{$gradelevel});
                   1933: }
                   1934: 
1.163     www      1935: sub select_level_form {
                   1936:     my ($deflevel,$name)=@_;
                   1937:     unless ($deflevel) { $deflevel=0; }
1.167     www      1938:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   1939:     for (my $i=0; $i<=18; $i++) {
                   1940:         $selectform.="<option value=\"$i\" ".
1.253     albertel 1941:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      1942:                 ">".&gradeleveldescription($i)."</option>\n";
                   1943:     }
                   1944:     $selectform.="</select>";
                   1945:     return $selectform;
1.163     www      1946: }
1.167     www      1947: 
1.35      matthew  1948: #-------------------------------------------
                   1949: 
1.45      matthew  1950: =pod
                   1951: 
1.910     raeburn  1952: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)
1.35      matthew  1953: 
                   1954: Returns a string containing a <select name='$name' size='1'> form to 
                   1955: allow a user to select the domain to preform an operation in.  
                   1956: See loncreateuser.pm for an example invocation and use.
                   1957: 
1.90      www      1958: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   1959: selected");
                   1960: 
1.743     raeburn  1961: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   1962: 
1.910     raeburn  1963: 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.
                   1964: 
                   1965: The optional $incdoms is a reference to an array of domains which will be the only available options. 
1.563     raeburn  1966: 
1.35      matthew  1967: =cut
                   1968: 
                   1969: #-------------------------------------------
1.34      matthew  1970: sub select_dom_form {
1.910     raeburn  1971:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_;
1.872     raeburn  1972:     if ($onchange) {
1.874     raeburn  1973:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  1974:     }
1.910     raeburn  1975:     my @domains;
                   1976:     if (ref($incdoms) eq 'ARRAY') {
                   1977:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   1978:     } else {
                   1979:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   1980:     }
1.90      www      1981:     if ($includeempty) { @domains=('',@domains); }
1.743     raeburn  1982:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 1983:     foreach my $dom (@domains) {
                   1984:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  1985:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   1986:         if ($showdomdesc) {
                   1987:             if ($dom ne '') {
                   1988:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   1989:                 if ($domdesc ne '') {
                   1990:                     $selectdomain .= ' ('.$domdesc.')';
                   1991:                 }
                   1992:             } 
                   1993:         }
                   1994:         $selectdomain .= "</option>\n";
1.34      matthew  1995:     }
                   1996:     $selectdomain.="</select>";
                   1997:     return $selectdomain;
                   1998: }
                   1999: 
1.35      matthew  2000: #-------------------------------------------
                   2001: 
1.45      matthew  2002: =pod
                   2003: 
1.648     raeburn  2004: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2005: 
1.586     raeburn  2006: input: 4 arguments (two required, two optional) - 
                   2007:     $domain - domain of new user
                   2008:     $name - name of form element
                   2009:     $default - Value of 'default' causes a default item to be first 
                   2010:                             option, and selected by default. 
                   2011:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2012:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2013: output: returns 2 items: 
1.586     raeburn  2014: (a) form element which contains either:
                   2015:    (i) <select name="$name">
                   2016:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2017:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2018:        </select>
                   2019:        form item if there are multiple library servers in $domain, or
                   2020:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2021:        if there is only one library server in $domain.
                   2022: 
                   2023: (b) number of library servers found.
                   2024: 
                   2025: See loncreateuser.pm for example of use.
1.35      matthew  2026: 
                   2027: =cut
                   2028: 
                   2029: #-------------------------------------------
1.586     raeburn  2030: sub home_server_form_item {
                   2031:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2032:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2033:     my $result;
                   2034:     my $numlib = keys(%servers);
                   2035:     if ($numlib > 1) {
                   2036:         $result .= '<select name="'.$name.'" />'."\n";
                   2037:         if ($default) {
1.804     bisitz   2038:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2039:                        '</option>'."\n";
                   2040:         }
                   2041:         foreach my $hostid (sort(keys(%servers))) {
                   2042:             $result.= '<option value="'.$hostid.'">'.
                   2043: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2044:         }
                   2045:         $result .= '</select>'."\n";
                   2046:     } elsif ($numlib == 1) {
                   2047:         my $hostid;
                   2048:         foreach my $item (keys(%servers)) {
                   2049:             $hostid = $item;
                   2050:         }
                   2051:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2052:                    $hostid.'" />';
                   2053:                    if (!$hide) {
                   2054:                        $result .= $hostid.' '.$servers{$hostid};
                   2055:                    }
                   2056:                    $result .= "\n";
                   2057:     } elsif ($default) {
                   2058:         $result .= '<input type="hidden" name="'.$name.
                   2059:                    '" value="default" />';
                   2060:                    if (!$hide) {
                   2061:                        $result .= &mt('default');
                   2062:                    }
                   2063:                    $result .= "\n";
1.33      matthew  2064:     }
1.586     raeburn  2065:     return ($result,$numlib);
1.33      matthew  2066: }
1.112     bowersj2 2067: 
                   2068: =pod
                   2069: 
1.534     albertel 2070: =back 
                   2071: 
1.112     bowersj2 2072: =cut
1.87      matthew  2073: 
                   2074: ###############################################################
1.112     bowersj2 2075: ##                  Decoding User Agent                      ##
1.87      matthew  2076: ###############################################################
                   2077: 
                   2078: =pod
                   2079: 
1.112     bowersj2 2080: =head1 Decoding the User Agent
                   2081: 
                   2082: =over 4
                   2083: 
                   2084: =item * &decode_user_agent()
1.87      matthew  2085: 
                   2086: Inputs: $r
                   2087: 
                   2088: Outputs:
                   2089: 
                   2090: =over 4
                   2091: 
1.112     bowersj2 2092: =item * $httpbrowser
1.87      matthew  2093: 
1.112     bowersj2 2094: =item * $clientbrowser
1.87      matthew  2095: 
1.112     bowersj2 2096: =item * $clientversion
1.87      matthew  2097: 
1.112     bowersj2 2098: =item * $clientmathml
1.87      matthew  2099: 
1.112     bowersj2 2100: =item * $clientunicode
1.87      matthew  2101: 
1.112     bowersj2 2102: =item * $clientos
1.87      matthew  2103: 
                   2104: =back
                   2105: 
1.157     matthew  2106: =back 
                   2107: 
1.87      matthew  2108: =cut
                   2109: 
                   2110: ###############################################################
                   2111: ###############################################################
                   2112: sub decode_user_agent {
1.247     albertel 2113:     my ($r)=@_;
1.87      matthew  2114:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2115:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2116:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2117:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2118:     my $clientbrowser='unknown';
                   2119:     my $clientversion='0';
                   2120:     my $clientmathml='';
                   2121:     my $clientunicode='0';
                   2122:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2123:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2124: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2125: 	    $clientbrowser=$bname;
                   2126:             $httpbrowser=~/$vreg/i;
                   2127: 	    $clientversion=$1;
                   2128:             $clientmathml=($clientversion>=$minv);
                   2129:             $clientunicode=($clientversion>=$univ);
                   2130: 	}
                   2131:     }
                   2132:     my $clientos='unknown';
                   2133:     if (($httpbrowser=~/linux/i) ||
                   2134:         ($httpbrowser=~/unix/i) ||
                   2135:         ($httpbrowser=~/ux/i) ||
                   2136:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2137:     if (($httpbrowser=~/vax/i) ||
                   2138:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2139:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2140:     if (($httpbrowser=~/mac/i) ||
                   2141:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2142:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2143:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
                   2144:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   2145:             $clientunicode,$clientos,);
                   2146: }
                   2147: 
1.32      matthew  2148: ###############################################################
                   2149: ##    Authentication changing form generation subroutines    ##
                   2150: ###############################################################
                   2151: ##
                   2152: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2153: ## hash, and have reasonable default values.
                   2154: ##
                   2155: ##    formname = the name given in the <form> tag.
1.35      matthew  2156: #-------------------------------------------
                   2157: 
1.45      matthew  2158: =pod
                   2159: 
1.112     bowersj2 2160: =head1 Authentication Routines
                   2161: 
                   2162: =over 4
                   2163: 
1.648     raeburn  2164: =item * &authform_xxxxxx()
1.35      matthew  2165: 
                   2166: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2167: handle some of the conveniences required for authentication forms.  
                   2168: This is not an optimal method, but it works.  
                   2169: 
                   2170: =over 4
                   2171: 
1.112     bowersj2 2172: =item * authform_header
1.35      matthew  2173: 
1.112     bowersj2 2174: =item * authform_authorwarning
1.35      matthew  2175: 
1.112     bowersj2 2176: =item * authform_nochange
1.35      matthew  2177: 
1.112     bowersj2 2178: =item * authform_kerberos
1.35      matthew  2179: 
1.112     bowersj2 2180: =item * authform_internal
1.35      matthew  2181: 
1.112     bowersj2 2182: =item * authform_filesystem
1.35      matthew  2183: 
                   2184: =back
                   2185: 
1.648     raeburn  2186: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2187: 
1.35      matthew  2188: =cut
                   2189: 
                   2190: #-------------------------------------------
1.32      matthew  2191: sub authform_header{  
                   2192:     my %in = (
                   2193:         formname => 'cu',
1.80      albertel 2194:         kerb_def_dom => '',
1.32      matthew  2195:         @_,
                   2196:     );
                   2197:     $in{'formname'} = 'document.' . $in{'formname'};
                   2198:     my $result='';
1.80      albertel 2199: 
                   2200: #---------------------------------------------- Code for upper case translation
                   2201:     my $Javascript_toUpperCase;
                   2202:     unless ($in{kerb_def_dom}) {
                   2203:         $Javascript_toUpperCase =<<"END";
                   2204:         switch (choice) {
                   2205:            case 'krb': currentform.elements[choicearg].value =
                   2206:                currentform.elements[choicearg].value.toUpperCase();
                   2207:                break;
                   2208:            default:
                   2209:         }
                   2210: END
                   2211:     } else {
                   2212:         $Javascript_toUpperCase = "";
                   2213:     }
                   2214: 
1.165     raeburn  2215:     my $radioval = "'nochange'";
1.591     raeburn  2216:     if (defined($in{'curr_authtype'})) {
                   2217:         if ($in{'curr_authtype'} ne '') {
                   2218:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2219:         }
1.174     matthew  2220:     }
1.165     raeburn  2221:     my $argfield = 'null';
1.591     raeburn  2222:     if (defined($in{'mode'})) {
1.165     raeburn  2223:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2224:             if (defined($in{'curr_autharg'})) {
                   2225:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2226:                     $argfield = "'$in{'curr_autharg'}'";
                   2227:                 }
                   2228:             }
                   2229:         }
                   2230:     }
                   2231: 
1.32      matthew  2232:     $result.=<<"END";
                   2233: var current = new Object();
1.165     raeburn  2234: current.radiovalue = $radioval;
                   2235: current.argfield = $argfield;
1.32      matthew  2236: 
                   2237: function changed_radio(choice,currentform) {
                   2238:     var choicearg = choice + 'arg';
                   2239:     // If a radio button in changed, we need to change the argfield
                   2240:     if (current.radiovalue != choice) {
                   2241:         current.radiovalue = choice;
                   2242:         if (current.argfield != null) {
                   2243:             currentform.elements[current.argfield].value = '';
                   2244:         }
                   2245:         if (choice == 'nochange') {
                   2246:             current.argfield = null;
                   2247:         } else {
                   2248:             current.argfield = choicearg;
                   2249:             switch(choice) {
                   2250:                 case 'krb': 
                   2251:                     currentform.elements[current.argfield].value = 
                   2252:                         "$in{'kerb_def_dom'}";
                   2253:                 break;
                   2254:               default:
                   2255:                 break;
                   2256:             }
                   2257:         }
                   2258:     }
                   2259:     return;
                   2260: }
1.22      www      2261: 
1.32      matthew  2262: function changed_text(choice,currentform) {
                   2263:     var choicearg = choice + 'arg';
                   2264:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2265:         $Javascript_toUpperCase
1.32      matthew  2266:         // clear old field
                   2267:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2268:             currentform.elements[current.argfield].value = '';
                   2269:         }
                   2270:         current.argfield = choicearg;
                   2271:     }
                   2272:     set_auth_radio_buttons(choice,currentform);
                   2273:     return;
1.20      www      2274: }
1.32      matthew  2275: 
                   2276: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2277:     var numauthchoices = currentform.login.length;
                   2278:     if (typeof numauthchoices  == "undefined") {
                   2279:         return;
                   2280:     } 
1.32      matthew  2281:     var i=0;
1.986     raeburn  2282:     while (i < numauthchoices) {
1.32      matthew  2283:         if (currentform.login[i].value == newvalue) { break; }
                   2284:         i++;
                   2285:     }
1.986     raeburn  2286:     if (i == numauthchoices) {
1.32      matthew  2287:         return;
                   2288:     }
                   2289:     current.radiovalue = newvalue;
                   2290:     currentform.login[i].checked = true;
                   2291:     return;
                   2292: }
                   2293: END
                   2294:     return $result;
                   2295: }
                   2296: 
                   2297: sub authform_authorwarning{
                   2298:     my $result='';
1.144     matthew  2299:     $result='<i>'.
                   2300:         &mt('As a general rule, only authors or co-authors should be '.
                   2301:             'filesystem authenticated '.
                   2302:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2303:     return $result;
                   2304: }
                   2305: 
                   2306: sub authform_nochange{  
                   2307:     my %in = (
                   2308:               formname => 'document.cu',
                   2309:               kerb_def_dom => 'MSU.EDU',
                   2310:               @_,
                   2311:           );
1.586     raeburn  2312:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'}); 
                   2313:     my $result;
                   2314:     if (keys(%can_assign) == 0) {
                   2315:         $result = &mt('Under you current role you are not permitted to change login settings for this user');  
                   2316:     } else {
                   2317:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2318:                   '<input type="radio" name="login" value="nochange" '.
                   2319:                   'checked="checked" onclick="'.
1.281     albertel 2320:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2321: 	    '</label>';
1.586     raeburn  2322:     }
1.32      matthew  2323:     return $result;
                   2324: }
                   2325: 
1.591     raeburn  2326: sub authform_kerberos {
1.32      matthew  2327:     my %in = (
                   2328:               formname => 'document.cu',
                   2329:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2330:               kerb_def_auth => 'krb4',
1.32      matthew  2331:               @_,
                   2332:               );
1.586     raeburn  2333:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2334:         $autharg,$jscall);
                   2335:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.80      albertel 2336:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2337:        $check5 = ' checked="checked"';
1.80      albertel 2338:     } else {
1.772     bisitz   2339:        $check4 = ' checked="checked"';
1.80      albertel 2340:     }
1.165     raeburn  2341:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2342:     if (defined($in{'curr_authtype'})) {
                   2343:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2344:             $krbcheck = ' checked="checked"';
1.623     raeburn  2345:             if (defined($in{'mode'})) {
                   2346:                 if ($in{'mode'} eq 'modifyuser') {
                   2347:                     $krbcheck = '';
                   2348:                 }
                   2349:             }
1.591     raeburn  2350:             if (defined($in{'curr_kerb_ver'})) {
                   2351:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2352:                     $check5 = ' checked="checked"';
1.591     raeburn  2353:                     $check4 = '';
                   2354:                 } else {
1.772     bisitz   2355:                     $check4 = ' checked="checked"';
1.591     raeburn  2356:                     $check5 = '';
                   2357:                 }
1.586     raeburn  2358:             }
1.591     raeburn  2359:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2360:                 $krbarg = $in{'curr_autharg'};
                   2361:             }
1.586     raeburn  2362:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2363:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2364:                     $result = 
                   2365:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2366:         $in{'curr_autharg'},$krbver);
                   2367:                 } else {
                   2368:                     $result =
                   2369:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2370:                 }
                   2371:                 return $result; 
                   2372:             }
                   2373:         }
                   2374:     } else {
                   2375:         if ($authnum == 1) {
1.784     bisitz   2376:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2377:         }
                   2378:     }
1.586     raeburn  2379:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2380:         return;
1.587     raeburn  2381:     } elsif ($authtype eq '') {
1.591     raeburn  2382:         if (defined($in{'mode'})) {
1.587     raeburn  2383:             if ($in{'mode'} eq 'modifycourse') {
                   2384:                 if ($authnum == 1) {
1.784     bisitz   2385:                     $authtype = '<input type="hidden" name="login" value="krb" />';
1.587     raeburn  2386:                 }
                   2387:             }
                   2388:         }
1.586     raeburn  2389:     }
                   2390:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2391:     if ($authtype eq '') {
                   2392:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2393:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2394:                     $krbcheck.' />';
                   2395:     }
                   2396:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
                   2397:         ($can_assign{'krb4'} && !$can_assign{'krb5'} && 
                   2398:          $in{'curr_authtype'} eq 'krb5') ||
                   2399:         (!$can_assign{'krb4'} && $can_assign{'krb5'} && 
                   2400:          $in{'curr_authtype'} eq 'krb4')) {
                   2401:         $result .= &mt
1.144     matthew  2402:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2403:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2404:          '<label>'.$authtype,
1.281     albertel 2405:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2406:              'value="'.$krbarg.'" '.
1.144     matthew  2407:              'onchange="'.$jscall.'" />',
1.281     albertel 2408:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2409:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2410: 	 '</label>');
1.586     raeburn  2411:     } elsif ($can_assign{'krb4'}) {
                   2412:         $result .= &mt
                   2413:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2414:          '[_3] Version 4 [_4]',
                   2415:          '<label>'.$authtype,
                   2416:          '</label><input type="text" size="10" name="krbarg" '.
                   2417:              'value="'.$krbarg.'" '.
                   2418:              'onchange="'.$jscall.'" />',
                   2419:          '<label><input type="hidden" name="krbver" value="4" />',
                   2420:          '</label>');
                   2421:     } elsif ($can_assign{'krb5'}) {
                   2422:         $result .= &mt
                   2423:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2424:          '[_3] Version 5 [_4]',
                   2425:          '<label>'.$authtype,
                   2426:          '</label><input type="text" size="10" name="krbarg" '.
                   2427:              'value="'.$krbarg.'" '.
                   2428:              'onchange="'.$jscall.'" />',
                   2429:          '<label><input type="hidden" name="krbver" value="5" />',
                   2430:          '</label>');
                   2431:     }
1.32      matthew  2432:     return $result;
                   2433: }
                   2434: 
                   2435: sub authform_internal{  
1.586     raeburn  2436:     my %in = (
1.32      matthew  2437:                 formname => 'document.cu',
                   2438:                 kerb_def_dom => 'MSU.EDU',
                   2439:                 @_,
                   2440:                 );
1.586     raeburn  2441:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
                   2442:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2443:     if (defined($in{'curr_authtype'})) {
                   2444:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2445:             if ($can_assign{'int'}) {
1.772     bisitz   2446:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2447:                 if (defined($in{'mode'})) {
                   2448:                     if ($in{'mode'} eq 'modifyuser') {
                   2449:                         $intcheck = '';
                   2450:                     }
                   2451:                 }
1.591     raeburn  2452:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2453:                     $intarg = $in{'curr_autharg'};
                   2454:                 }
                   2455:             } else {
                   2456:                 $result = &mt('Currently internally authenticated.');
                   2457:                 return $result;
1.165     raeburn  2458:             }
                   2459:         }
1.586     raeburn  2460:     } else {
                   2461:         if ($authnum == 1) {
1.784     bisitz   2462:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2463:         }
                   2464:     }
                   2465:     if (!$can_assign{'int'}) {
                   2466:         return;
1.587     raeburn  2467:     } elsif ($authtype eq '') {
1.591     raeburn  2468:         if (defined($in{'mode'})) {
1.587     raeburn  2469:             if ($in{'mode'} eq 'modifycourse') {
                   2470:                 if ($authnum == 1) {
1.784     bisitz   2471:                     $authtype = '<input type="hidden" name="login" value="int" />';
1.587     raeburn  2472:                 }
                   2473:             }
                   2474:         }
1.165     raeburn  2475:     }
1.586     raeburn  2476:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2477:     if ($authtype eq '') {
                   2478:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2479:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2480:     }
1.605     bisitz   2481:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2482:                $intarg.'" onchange="'.$jscall.'" />';
                   2483:     $result = &mt
1.144     matthew  2484:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2485:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2486:     $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  2487:     return $result;
                   2488: }
                   2489: 
                   2490: sub authform_local{  
                   2491:     my %in = (
                   2492:               formname => 'document.cu',
                   2493:               kerb_def_dom => 'MSU.EDU',
                   2494:               @_,
                   2495:               );
1.586     raeburn  2496:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
                   2497:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2498:     if (defined($in{'curr_authtype'})) {
                   2499:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2500:             if ($can_assign{'loc'}) {
1.772     bisitz   2501:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2502:                 if (defined($in{'mode'})) {
                   2503:                     if ($in{'mode'} eq 'modifyuser') {
                   2504:                         $loccheck = '';
                   2505:                     }
                   2506:                 }
1.591     raeburn  2507:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2508:                     $locarg = $in{'curr_autharg'};
                   2509:                 }
                   2510:             } else {
                   2511:                 $result = &mt('Currently using local (institutional) authentication.');
                   2512:                 return $result;
1.165     raeburn  2513:             }
                   2514:         }
1.586     raeburn  2515:     } else {
                   2516:         if ($authnum == 1) {
1.784     bisitz   2517:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2518:         }
                   2519:     }
                   2520:     if (!$can_assign{'loc'}) {
                   2521:         return;
1.587     raeburn  2522:     } elsif ($authtype eq '') {
1.591     raeburn  2523:         if (defined($in{'mode'})) {
1.587     raeburn  2524:             if ($in{'mode'} eq 'modifycourse') {
                   2525:                 if ($authnum == 1) {
1.784     bisitz   2526:                     $authtype = '<input type="hidden" name="login" value="loc" />';
1.587     raeburn  2527:                 }
                   2528:             }
                   2529:         }
1.165     raeburn  2530:     }
1.586     raeburn  2531:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2532:     if ($authtype eq '') {
                   2533:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2534:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2535:                     $jscall.'" />';
                   2536:     }
                   2537:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2538:                $locarg.'" onchange="'.$jscall.'" />';
                   2539:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2540:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2541:     return $result;
                   2542: }
                   2543: 
                   2544: sub authform_filesystem{  
                   2545:     my %in = (
                   2546:               formname => 'document.cu',
                   2547:               kerb_def_dom => 'MSU.EDU',
                   2548:               @_,
                   2549:               );
1.586     raeburn  2550:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
                   2551:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2552:     if (defined($in{'curr_authtype'})) {
                   2553:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2554:             if ($can_assign{'fsys'}) {
1.772     bisitz   2555:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2556:                 if (defined($in{'mode'})) {
                   2557:                     if ($in{'mode'} eq 'modifyuser') {
                   2558:                         $fsyscheck = '';
                   2559:                     }
                   2560:                 }
1.586     raeburn  2561:             } else {
                   2562:                 $result = &mt('Currently Filesystem Authenticated.');
                   2563:                 return $result;
                   2564:             }           
                   2565:         }
                   2566:     } else {
                   2567:         if ($authnum == 1) {
1.784     bisitz   2568:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2569:         }
                   2570:     }
                   2571:     if (!$can_assign{'fsys'}) {
                   2572:         return;
1.587     raeburn  2573:     } elsif ($authtype eq '') {
1.591     raeburn  2574:         if (defined($in{'mode'})) {
1.587     raeburn  2575:             if ($in{'mode'} eq 'modifycourse') {
                   2576:                 if ($authnum == 1) {
1.784     bisitz   2577:                     $authtype = '<input type="hidden" name="login" value="fsys" />';
1.587     raeburn  2578:                 }
                   2579:             }
                   2580:         }
1.586     raeburn  2581:     }
                   2582:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2583:     if ($authtype eq '') {
                   2584:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2585:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2586:                     $jscall.'" />';
                   2587:     }
                   2588:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2589:                ' onchange="'.$jscall.'" />';
                   2590:     $result = &mt
1.144     matthew  2591:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2592:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2593:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2594:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2595:                   'onchange="'.$jscall.'" />');
1.32      matthew  2596:     return $result;
                   2597: }
                   2598: 
1.586     raeburn  2599: sub get_assignable_auth {
                   2600:     my ($dom) = @_;
                   2601:     if ($dom eq '') {
                   2602:         $dom = $env{'request.role.domain'};
                   2603:     }
                   2604:     my %can_assign = (
                   2605:                           krb4 => 1,
                   2606:                           krb5 => 1,
                   2607:                           int  => 1,
                   2608:                           loc  => 1,
                   2609:                      );
                   2610:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2611:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2612:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2613:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2614:             my $context;
                   2615:             if ($env{'request.role'} =~ /^au/) {
                   2616:                 $context = 'author';
                   2617:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2618:                 $context = 'domain';
                   2619:             } elsif ($env{'request.course.id'}) {
                   2620:                 $context = 'course';
                   2621:             }
                   2622:             if ($context) {
                   2623:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2624:                    %can_assign = %{$authhash->{$context}}; 
                   2625:                 }
                   2626:             }
                   2627:         }
                   2628:     }
                   2629:     my $authnum = 0;
                   2630:     foreach my $key (keys(%can_assign)) {
                   2631:         if ($can_assign{$key}) {
                   2632:             $authnum ++;
                   2633:         }
                   2634:     }
                   2635:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2636:         $authnum --;
                   2637:     }
                   2638:     return ($authnum,%can_assign);
                   2639: }
                   2640: 
1.80      albertel 2641: ###############################################################
                   2642: ##    Get Kerberos Defaults for Domain                 ##
                   2643: ###############################################################
                   2644: ##
                   2645: ## Returns default kerberos version and an associated argument
                   2646: ## as listed in file domain.tab. If not listed, provides
                   2647: ## appropriate default domain and kerberos version.
                   2648: ##
                   2649: #-------------------------------------------
                   2650: 
                   2651: =pod
                   2652: 
1.648     raeburn  2653: =item * &get_kerberos_defaults()
1.80      albertel 2654: 
                   2655: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2656: version and domain. If not found, it defaults to version 4 and the 
                   2657: domain of the server.
1.80      albertel 2658: 
1.648     raeburn  2659: =over 4
                   2660: 
1.80      albertel 2661: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2662: 
1.648     raeburn  2663: =back
                   2664: 
                   2665: =back
                   2666: 
1.80      albertel 2667: =cut
                   2668: 
                   2669: #-------------------------------------------
                   2670: sub get_kerberos_defaults {
                   2671:     my $domain=shift;
1.641     raeburn  2672:     my ($krbdef,$krbdefdom);
                   2673:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2674:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2675:         $krbdef = $domdefaults{'auth_def'};
                   2676:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2677:     } else {
1.80      albertel 2678:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2679:         my $krbdefdom=$1;
                   2680:         $krbdefdom=~tr/a-z/A-Z/;
                   2681:         $krbdef = "krb4";
                   2682:     }
                   2683:     return ($krbdef,$krbdefdom);
                   2684: }
1.112     bowersj2 2685: 
1.32      matthew  2686: 
1.46      matthew  2687: ###############################################################
                   2688: ##                Thesaurus Functions                        ##
                   2689: ###############################################################
1.20      www      2690: 
1.46      matthew  2691: =pod
1.20      www      2692: 
1.112     bowersj2 2693: =head1 Thesaurus Functions
                   2694: 
                   2695: =over 4
                   2696: 
1.648     raeburn  2697: =item * &initialize_keywords()
1.46      matthew  2698: 
                   2699: Initializes the package variable %Keywords if it is empty.  Uses the
                   2700: package variable $thesaurus_db_file.
                   2701: 
                   2702: =cut
                   2703: 
                   2704: ###################################################
                   2705: 
                   2706: sub initialize_keywords {
                   2707:     return 1 if (scalar keys(%Keywords));
                   2708:     # If we are here, %Keywords is empty, so fill it up
                   2709:     #   Make sure the file we need exists...
                   2710:     if (! -e $thesaurus_db_file) {
                   2711:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2712:                                  " failed because it does not exist");
                   2713:         return 0;
                   2714:     }
                   2715:     #   Set up the hash as a database
                   2716:     my %thesaurus_db;
                   2717:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2718:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2719:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2720:                                  $thesaurus_db_file);
                   2721:         return 0;
                   2722:     } 
                   2723:     #  Get the average number of appearances of a word.
                   2724:     my $avecount = $thesaurus_db{'average.count'};
                   2725:     #  Put keywords (those that appear > average) into %Keywords
                   2726:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2727:         my ($count,undef) = split /:/,$data;
                   2728:         $Keywords{$word}++ if ($count > $avecount);
                   2729:     }
                   2730:     untie %thesaurus_db;
                   2731:     # Remove special values from %Keywords.
1.356     albertel 2732:     foreach my $value ('total.count','average.count') {
                   2733:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2734:   }
1.46      matthew  2735:     return 1;
                   2736: }
                   2737: 
                   2738: ###################################################
                   2739: 
                   2740: =pod
                   2741: 
1.648     raeburn  2742: =item * &keyword($word)
1.46      matthew  2743: 
                   2744: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   2745: than the average number of times in the thesaurus database.  Calls 
                   2746: &initialize_keywords
                   2747: 
                   2748: =cut
                   2749: 
                   2750: ###################################################
1.20      www      2751: 
                   2752: sub keyword {
1.46      matthew  2753:     return if (!&initialize_keywords());
                   2754:     my $word=lc(shift());
                   2755:     $word=~s/\W//g;
                   2756:     return exists($Keywords{$word});
1.20      www      2757: }
1.46      matthew  2758: 
                   2759: ###############################################################
                   2760: 
                   2761: =pod 
1.20      www      2762: 
1.648     raeburn  2763: =item * &get_related_words()
1.46      matthew  2764: 
1.160     matthew  2765: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  2766: an array of words.  If the keyword is not in the thesaurus, an empty array
                   2767: will be returned.  The order of the words returned is determined by the
                   2768: database which holds them.
                   2769: 
                   2770: Uses global $thesaurus_db_file.
                   2771: 
                   2772: =cut
                   2773: 
                   2774: ###############################################################
                   2775: sub get_related_words {
                   2776:     my $keyword = shift;
                   2777:     my %thesaurus_db;
                   2778:     if (! -e $thesaurus_db_file) {
                   2779:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   2780:                                  "failed because the file does not exist");
                   2781:         return ();
                   2782:     }
                   2783:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2784:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2785:         return ();
                   2786:     } 
                   2787:     my @Words=();
1.429     www      2788:     my $count=0;
1.46      matthew  2789:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 2790: 	# The first element is the number of times
                   2791: 	# the word appears.  We do not need it now.
1.429     www      2792: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   2793: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   2794: 	my $threshold=$mostfrequentcount/10;
                   2795:         foreach my $possibleword (@RelatedWords) {
                   2796:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   2797:             if ($wordcount>$threshold) {
                   2798: 		push(@Words,$word);
                   2799:                 $count++;
                   2800:                 if ($count>10) { last; }
                   2801: 	    }
1.20      www      2802:         }
                   2803:     }
1.46      matthew  2804:     untie %thesaurus_db;
                   2805:     return @Words;
1.14      harris41 2806: }
1.46      matthew  2807: 
1.112     bowersj2 2808: =pod
                   2809: 
                   2810: =back
                   2811: 
                   2812: =cut
1.61      www      2813: 
                   2814: # -------------------------------------------------------------- Plaintext name
1.81      albertel 2815: =pod
                   2816: 
1.112     bowersj2 2817: =head1 User Name Functions
                   2818: 
                   2819: =over 4
                   2820: 
1.648     raeburn  2821: =item * &plainname($uname,$udom,$first)
1.81      albertel 2822: 
1.112     bowersj2 2823: Takes a users logon name and returns it as a string in
1.226     albertel 2824: "first middle last generation" form 
                   2825: if $first is set to 'lastname' then it returns it as
                   2826: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 2827: 
                   2828: =cut
1.61      www      2829: 
1.295     www      2830: 
1.81      albertel 2831: ###############################################################
1.61      www      2832: sub plainname {
1.226     albertel 2833:     my ($uname,$udom,$first)=@_;
1.537     albertel 2834:     return if (!defined($uname) || !defined($udom));
1.295     www      2835:     my %names=&getnames($uname,$udom);
1.226     albertel 2836:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   2837: 					  $names{'middlename'},
                   2838: 					  $names{'lastname'},
                   2839: 					  $names{'generation'},$first);
                   2840:     $name=~s/^\s+//;
1.62      www      2841:     $name=~s/\s+$//;
                   2842:     $name=~s/\s+/ /g;
1.353     albertel 2843:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      2844:     return $name;
1.61      www      2845: }
1.66      www      2846: 
                   2847: # -------------------------------------------------------------------- Nickname
1.81      albertel 2848: =pod
                   2849: 
1.648     raeburn  2850: =item * &nickname($uname,$udom)
1.81      albertel 2851: 
                   2852: Gets a users name and returns it as a string as
                   2853: 
                   2854: "&quot;nickname&quot;"
1.66      www      2855: 
1.81      albertel 2856: if the user has a nickname or
                   2857: 
                   2858: "first middle last generation"
                   2859: 
                   2860: if the user does not
                   2861: 
                   2862: =cut
1.66      www      2863: 
                   2864: sub nickname {
                   2865:     my ($uname,$udom)=@_;
1.537     albertel 2866:     return if (!defined($uname) || !defined($udom));
1.295     www      2867:     my %names=&getnames($uname,$udom);
1.68      albertel 2868:     my $name=$names{'nickname'};
1.66      www      2869:     if ($name) {
                   2870:        $name='&quot;'.$name.'&quot;'; 
                   2871:     } else {
                   2872:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   2873: 	     $names{'lastname'}.' '.$names{'generation'};
                   2874:        $name=~s/\s+$//;
                   2875:        $name=~s/\s+/ /g;
                   2876:     }
                   2877:     return $name;
                   2878: }
                   2879: 
1.295     www      2880: sub getnames {
                   2881:     my ($uname,$udom)=@_;
1.537     albertel 2882:     return if (!defined($uname) || !defined($udom));
1.433     albertel 2883:     if ($udom eq 'public' && $uname eq 'public') {
                   2884: 	return ('lastname' => &mt('Public'));
                   2885:     }
1.295     www      2886:     my $id=$uname.':'.$udom;
                   2887:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   2888:     if ($cached) {
                   2889: 	return %{$names};
                   2890:     } else {
                   2891: 	my %loadnames=&Apache::lonnet::get('environment',
                   2892:                     ['firstname','middlename','lastname','generation','nickname'],
                   2893: 					 $udom,$uname);
                   2894: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   2895: 	return %loadnames;
                   2896:     }
                   2897: }
1.61      www      2898: 
1.542     raeburn  2899: # -------------------------------------------------------------------- getemails
1.648     raeburn  2900: 
1.542     raeburn  2901: =pod
                   2902: 
1.648     raeburn  2903: =item * &getemails($uname,$udom)
1.542     raeburn  2904: 
                   2905: Gets a user's email information and returns it as a hash with keys:
                   2906: notification, critnotification, permanentemail
                   2907: 
                   2908: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  2909: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  2910:  
1.648     raeburn  2911: 
1.542     raeburn  2912: =cut
                   2913: 
1.648     raeburn  2914: 
1.466     albertel 2915: sub getemails {
                   2916:     my ($uname,$udom)=@_;
                   2917:     if ($udom eq 'public' && $uname eq 'public') {
                   2918: 	return;
                   2919:     }
1.467     www      2920:     if (!$udom) { $udom=$env{'user.domain'}; }
                   2921:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 2922:     my $id=$uname.':'.$udom;
                   2923:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   2924:     if ($cached) {
                   2925: 	return %{$names};
                   2926:     } else {
                   2927: 	my %loadnames=&Apache::lonnet::get('environment',
                   2928:                     			   ['notification','critnotification',
                   2929: 					    'permanentemail'],
                   2930: 					   $udom,$uname);
                   2931: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   2932: 	return %loadnames;
                   2933:     }
                   2934: }
                   2935: 
1.551     albertel 2936: sub flush_email_cache {
                   2937:     my ($uname,$udom)=@_;
                   2938:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   2939:     if (!$uname) { $uname=$env{'user.name'};   }
                   2940:     return if ($udom eq 'public' && $uname eq 'public');
                   2941:     my $id=$uname.':'.$udom;
                   2942:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   2943: }
                   2944: 
1.728     raeburn  2945: # -------------------------------------------------------------------- getlangs
                   2946: 
                   2947: =pod
                   2948: 
                   2949: =item * &getlangs($uname,$udom)
                   2950: 
                   2951: Gets a user's language preference and returns it as a hash with key:
                   2952: language.
                   2953: 
                   2954: =cut
                   2955: 
                   2956: 
                   2957: sub getlangs {
                   2958:     my ($uname,$udom) = @_;
                   2959:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   2960:     if (!$uname) { $uname=$env{'user.name'};   }
                   2961:     my $id=$uname.':'.$udom;
                   2962:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   2963:     if ($cached) {
                   2964:         return %{$langs};
                   2965:     } else {
                   2966:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   2967:                                            $udom,$uname);
                   2968:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   2969:         return %loadlangs;
                   2970:     }
                   2971: }
                   2972: 
                   2973: sub flush_langs_cache {
                   2974:     my ($uname,$udom)=@_;
                   2975:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   2976:     if (!$uname) { $uname=$env{'user.name'};   }
                   2977:     return if ($udom eq 'public' && $uname eq 'public');
                   2978:     my $id=$uname.':'.$udom;
                   2979:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   2980: }
                   2981: 
1.61      www      2982: # ------------------------------------------------------------------ Screenname
1.81      albertel 2983: 
                   2984: =pod
                   2985: 
1.648     raeburn  2986: =item * &screenname($uname,$udom)
1.81      albertel 2987: 
                   2988: Gets a users screenname and returns it as a string
                   2989: 
                   2990: =cut
1.61      www      2991: 
                   2992: sub screenname {
                   2993:     my ($uname,$udom)=@_;
1.258     albertel 2994:     if ($uname eq $env{'user.name'} &&
                   2995: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 2996:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 2997:     return $names{'screenname'};
1.62      www      2998: }
                   2999: 
1.212     albertel 3000: 
1.802     bisitz   3001: # ------------------------------------------------------------- Confirm Wrapper
                   3002: =pod
                   3003: 
                   3004: =item confirmwrapper
                   3005: 
                   3006: Wrap messages about completion of operation in box
                   3007: 
                   3008: =cut
                   3009: 
                   3010: sub confirmwrapper {
                   3011:     my ($message)=@_;
                   3012:     if ($message) {
                   3013:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3014:                .$message."\n"
                   3015:                .'</div>'."\n";
                   3016:     } else {
                   3017:         return $message;
                   3018:     }
                   3019: }
                   3020: 
1.62      www      3021: # ------------------------------------------------------------- Message Wrapper
                   3022: 
                   3023: sub messagewrapper {
1.369     www      3024:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3025:     return 
1.441     albertel 3026:         '<a href="/adm/email?compose=individual&amp;'.
                   3027:         'recname='.$username.'&amp;recdom='.$domain.
                   3028: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3029:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3030: }
1.802     bisitz   3031: 
1.74      www      3032: # --------------------------------------------------------------- Notes Wrapper
                   3033: 
                   3034: sub noteswrapper {
                   3035:     my ($link,$un,$do)=@_;
                   3036:     return 
1.896     amueller 3037: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3038: }
1.802     bisitz   3039: 
1.62      www      3040: # ------------------------------------------------------------- Aboutme Wrapper
                   3041: 
                   3042: sub aboutmewrapper {
1.166     www      3043:     my ($link,$username,$domain,$target)=@_;
1.447     raeburn  3044:     if (!defined($username)  && !defined($domain)) {
                   3045:         return;
                   3046:     }
1.892     amueller 3047:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme?forcestudent=1"'.
1.756     weissno  3048: 	($target?' target="$target"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3049: }
                   3050: 
                   3051: # ------------------------------------------------------------ Syllabus Wrapper
                   3052: 
                   3053: sub syllabuswrapper {
1.707     bisitz   3054:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3055:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3056: }
1.14      harris41 3057: 
1.802     bisitz   3058: # -----------------------------------------------------------------------------
                   3059: 
1.208     matthew  3060: sub track_student_link {
1.887     raeburn  3061:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3062:     my $link ="/adm/trackstudent?";
1.208     matthew  3063:     my $title = 'View recent activity';
                   3064:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3065:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3066:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3067:         $title .= ' of this student';
1.268     albertel 3068:     } 
1.208     matthew  3069:     if (defined($target) && $target !~ /^\s*$/) {
                   3070:         $target = qq{target="$target"};
                   3071:     } else {
                   3072:         $target = '';
                   3073:     }
1.268     albertel 3074:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3075:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3076:     $title = &mt($title);
                   3077:     $linktext = &mt($linktext);
1.448     albertel 3078:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3079: 	&help_open_topic('View_recent_activity');
1.208     matthew  3080: }
                   3081: 
1.781     raeburn  3082: sub slot_reservations_link {
                   3083:     my ($linktext,$sname,$sdom,$target) = @_;
                   3084:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3085:     my $title = 'View slot reservation history';
                   3086:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3087:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3088:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3089:         $title .= ' of this student';
                   3090:     }
                   3091:     if (defined($target) && $target !~ /^\s*$/) {
                   3092:         $target = qq{target="$target"};
                   3093:     } else {
                   3094:         $target = '';
                   3095:     }
                   3096:     $title = &mt($title);
                   3097:     $linktext = &mt($linktext);
                   3098:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3099: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3100: 
                   3101: }
                   3102: 
1.508     www      3103: # ===================================================== Display a student photo
                   3104: 
                   3105: 
1.509     albertel 3106: sub student_image_tag {
1.508     www      3107:     my ($domain,$user)=@_;
                   3108:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3109:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3110: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3111:     } else {
                   3112: 	return '';
                   3113:     }
                   3114: }
                   3115: 
1.112     bowersj2 3116: =pod
                   3117: 
                   3118: =back
                   3119: 
                   3120: =head1 Access .tab File Data
                   3121: 
                   3122: =over 4
                   3123: 
1.648     raeburn  3124: =item * &languageids() 
1.112     bowersj2 3125: 
                   3126: returns list of all language ids
                   3127: 
                   3128: =cut
                   3129: 
1.14      harris41 3130: sub languageids {
1.16      harris41 3131:     return sort(keys(%language));
1.14      harris41 3132: }
                   3133: 
1.112     bowersj2 3134: =pod
                   3135: 
1.648     raeburn  3136: =item * &languagedescription() 
1.112     bowersj2 3137: 
                   3138: returns description of a specified language id
                   3139: 
                   3140: =cut
                   3141: 
1.14      harris41 3142: sub languagedescription {
1.125     www      3143:     my $code=shift;
                   3144:     return  ($supported_language{$code}?'* ':'').
                   3145:             $language{$code}.
1.126     www      3146: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3147: }
                   3148: 
                   3149: sub plainlanguagedescription {
                   3150:     my $code=shift;
                   3151:     return $language{$code};
                   3152: }
                   3153: 
                   3154: sub supportedlanguagecode {
                   3155:     my $code=shift;
                   3156:     return $supported_language{$code};
1.97      www      3157: }
                   3158: 
1.112     bowersj2 3159: =pod
                   3160: 
1.648     raeburn  3161: =item * &copyrightids() 
1.112     bowersj2 3162: 
                   3163: returns list of all copyrights
                   3164: 
                   3165: =cut
                   3166: 
                   3167: sub copyrightids {
                   3168:     return sort(keys(%cprtag));
                   3169: }
                   3170: 
                   3171: =pod
                   3172: 
1.648     raeburn  3173: =item * &copyrightdescription() 
1.112     bowersj2 3174: 
                   3175: returns description of a specified copyright id
                   3176: 
                   3177: =cut
                   3178: 
                   3179: sub copyrightdescription {
1.166     www      3180:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3181: }
1.197     matthew  3182: 
                   3183: =pod
                   3184: 
1.648     raeburn  3185: =item * &source_copyrightids() 
1.192     taceyjo1 3186: 
                   3187: returns list of all source copyrights
                   3188: 
                   3189: =cut
                   3190: 
                   3191: sub source_copyrightids {
                   3192:     return sort(keys(%scprtag));
                   3193: }
                   3194: 
                   3195: =pod
                   3196: 
1.648     raeburn  3197: =item * &source_copyrightdescription() 
1.192     taceyjo1 3198: 
                   3199: returns description of a specified source copyright id
                   3200: 
                   3201: =cut
                   3202: 
                   3203: sub source_copyrightdescription {
                   3204:     return &mt($scprtag{shift(@_)});
                   3205: }
1.112     bowersj2 3206: 
                   3207: =pod
                   3208: 
1.648     raeburn  3209: =item * &filecategories() 
1.112     bowersj2 3210: 
                   3211: returns list of all file categories
                   3212: 
                   3213: =cut
                   3214: 
                   3215: sub filecategories {
                   3216:     return sort(keys(%category_extensions));
                   3217: }
                   3218: 
                   3219: =pod
                   3220: 
1.648     raeburn  3221: =item * &filecategorytypes() 
1.112     bowersj2 3222: 
                   3223: returns list of file types belonging to a given file
                   3224: category
                   3225: 
                   3226: =cut
                   3227: 
                   3228: sub filecategorytypes {
1.356     albertel 3229:     my ($cat) = @_;
                   3230:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3231: }
                   3232: 
                   3233: =pod
                   3234: 
1.648     raeburn  3235: =item * &fileembstyle() 
1.112     bowersj2 3236: 
                   3237: returns embedding style for a specified file type
                   3238: 
                   3239: =cut
                   3240: 
                   3241: sub fileembstyle {
                   3242:     return $fe{lc(shift(@_))};
1.169     www      3243: }
                   3244: 
1.351     www      3245: sub filemimetype {
                   3246:     return $fm{lc(shift(@_))};
                   3247: }
                   3248: 
1.169     www      3249: 
                   3250: sub filecategoryselect {
                   3251:     my ($name,$value)=@_;
1.189     matthew  3252:     return &select_form($value,$name,
1.970     raeburn  3253:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3254: }
                   3255: 
                   3256: =pod
                   3257: 
1.648     raeburn  3258: =item * &filedescription() 
1.112     bowersj2 3259: 
                   3260: returns description for a specified file type
                   3261: 
                   3262: =cut
                   3263: 
                   3264: sub filedescription {
1.188     matthew  3265:     my $file_description = $fd{lc(shift())};
                   3266:     $file_description =~ s:([\[\]]):~$1:g;
                   3267:     return &mt($file_description);
1.112     bowersj2 3268: }
                   3269: 
                   3270: =pod
                   3271: 
1.648     raeburn  3272: =item * &filedescriptionex() 
1.112     bowersj2 3273: 
                   3274: returns description for a specified file type with
                   3275: extra formatting
                   3276: 
                   3277: =cut
                   3278: 
                   3279: sub filedescriptionex {
                   3280:     my $ex=shift;
1.188     matthew  3281:     my $file_description = $fd{lc($ex)};
                   3282:     $file_description =~ s:([\[\]]):~$1:g;
                   3283:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3284: }
                   3285: 
                   3286: # End of .tab access
                   3287: =pod
                   3288: 
                   3289: =back
                   3290: 
                   3291: =cut
                   3292: 
                   3293: # ------------------------------------------------------------------ File Types
                   3294: sub fileextensions {
                   3295:     return sort(keys(%fe));
                   3296: }
                   3297: 
1.97      www      3298: # ----------------------------------------------------------- Display Languages
                   3299: # returns a hash with all desired display languages
                   3300: #
                   3301: 
                   3302: sub display_languages {
                   3303:     my %languages=();
1.695     raeburn  3304:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3305: 	$languages{$lang}=1;
1.97      www      3306:     }
                   3307:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3308:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3309: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3310: 	    $languages{$lang}=1;
1.97      www      3311:         }
                   3312:     }
                   3313:     return %languages;
1.14      harris41 3314: }
                   3315: 
1.582     albertel 3316: sub languages {
                   3317:     my ($possible_langs) = @_;
1.695     raeburn  3318:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3319:     if (!ref($possible_langs)) {
                   3320: 	if( wantarray ) {
                   3321: 	    return @preferred_langs;
                   3322: 	} else {
                   3323: 	    return $preferred_langs[0];
                   3324: 	}
                   3325:     }
                   3326:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3327:     my @preferred_possibilities;
                   3328:     foreach my $preferred_lang (@preferred_langs) {
                   3329: 	if (exists($possibilities{$preferred_lang})) {
                   3330: 	    push(@preferred_possibilities, $preferred_lang);
                   3331: 	}
                   3332:     }
                   3333:     if( wantarray ) {
                   3334: 	return @preferred_possibilities;
                   3335:     }
                   3336:     return $preferred_possibilities[0];
                   3337: }
                   3338: 
1.742     raeburn  3339: sub user_lang {
                   3340:     my ($touname,$toudom,$fromcid) = @_;
                   3341:     my @userlangs;
                   3342:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3343:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3344:                     $env{'course.'.$fromcid.'.languages'}));
                   3345:     } else {
                   3346:         my %langhash = &getlangs($touname,$toudom);
                   3347:         if ($langhash{'languages'} ne '') {
                   3348:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3349:         } else {
                   3350:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3351:             if ($domdefs{'lang_def'} ne '') {
                   3352:                 @userlangs = ($domdefs{'lang_def'});
                   3353:             }
                   3354:         }
                   3355:     }
                   3356:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3357:     my $user_lh = Apache::localize->get_handle(@languages);
                   3358:     return $user_lh;
                   3359: }
                   3360: 
                   3361: 
1.112     bowersj2 3362: ###############################################################
                   3363: ##               Student Answer Attempts                     ##
                   3364: ###############################################################
                   3365: 
                   3366: =pod
                   3367: 
                   3368: =head1 Alternate Problem Views
                   3369: 
                   3370: =over 4
                   3371: 
1.648     raeburn  3372: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3373:     $getattempt, $regexp, $gradesub)
                   3374: 
                   3375: Return string with previous attempt on problem. Arguments:
                   3376: 
                   3377: =over 4
                   3378: 
                   3379: =item * $symb: Problem, including path
                   3380: 
                   3381: =item * $username: username of the desired student
                   3382: 
                   3383: =item * $domain: domain of the desired student
1.14      harris41 3384: 
1.112     bowersj2 3385: =item * $course: Course ID
1.14      harris41 3386: 
1.112     bowersj2 3387: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3388:     something
1.14      harris41 3389: 
1.112     bowersj2 3390: =item * $regexp: if string matches this regexp, the string will be
                   3391:     sent to $gradesub
1.14      harris41 3392: 
1.112     bowersj2 3393: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3394: 
1.112     bowersj2 3395: =back
1.14      harris41 3396: 
1.112     bowersj2 3397: The output string is a table containing all desired attempts, if any.
1.16      harris41 3398: 
1.112     bowersj2 3399: =cut
1.1       albertel 3400: 
                   3401: sub get_previous_attempt {
1.43      ng       3402:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3403:   my $prevattempts='';
1.43      ng       3404:   no strict 'refs';
1.1       albertel 3405:   if ($symb) {
1.3       albertel 3406:     my (%returnhash)=
                   3407:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3408:     if ($returnhash{'version'}) {
                   3409:       my %lasthash=();
                   3410:       my $version;
                   3411:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3412:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3413: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3414:         }
1.1       albertel 3415:       }
1.596     albertel 3416:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3417:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3418:       my (%typeparts,%lasthidden);
1.945     raeburn  3419:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3420:       foreach my $key (sort(keys(%lasthash))) {
                   3421: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3422: 	if ($#parts > 0) {
1.31      albertel 3423: 	  my $data=$parts[-1];
1.989     raeburn  3424:           next if ($data eq 'foilorder');
1.31      albertel 3425: 	  pop(@parts);
1.945     raeburn  3426:           if ($data eq 'type') {
                   3427:               unless ($showsurv) {
                   3428:                   my $id = join(',',@parts);
                   3429:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3430:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3431:                       $lasthidden{$ign.'.'.$id} = 1;
                   3432:                   }
1.945     raeburn  3433:               }
                   3434:               delete($lasthash{$key});
                   3435:           } else {
                   3436: 	      $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
                   3437:           }
1.31      albertel 3438: 	} else {
1.41      ng       3439: 	  if ($#parts == 0) {
                   3440: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3441: 	  } else {
                   3442: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3443: 	  }
1.31      albertel 3444: 	}
1.16      harris41 3445:       }
1.596     albertel 3446:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3447:       if ($getattempt eq '') {
                   3448: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3449:             my @hidden;
                   3450:             if (%typeparts) {
                   3451:                 foreach my $id (keys(%typeparts)) {
                   3452:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3453:                         push(@hidden,$id);
                   3454:                     }
                   3455:                 }
                   3456:             }
                   3457:             $prevattempts.=&start_data_table_row().
                   3458:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3459:             if (@hidden) {
                   3460:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3461:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3462:                     my $hide;
                   3463:                     foreach my $id (@hidden) {
                   3464:                         if ($key =~ /^\Q$id\E/) {
                   3465:                             $hide = 1;
                   3466:                             last;
                   3467:                         }
                   3468:                     }
                   3469:                     if ($hide) {
                   3470:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3471:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3472:                             my $value = &format_previous_attempt_value($key,
                   3473:                                              $returnhash{$version.':'.$key});
                   3474:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3475:                         } else {
                   3476:                             $prevattempts.='<td>&nbsp;</td>';
                   3477:                         }
                   3478:                     } else {
                   3479:                         if ($key =~ /\./) {
                   3480:                             my $value = &format_previous_attempt_value($key,
                   3481:                                               $returnhash{$version.':'.$key});
                   3482:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3483:                         } else {
                   3484:                             $prevattempts.='<td>&nbsp;</td>';
                   3485:                         }
                   3486:                     }
                   3487:                 }
                   3488:             } else {
                   3489: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3490:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3491: 		    my $value = &format_previous_attempt_value($key,
                   3492: 			            $returnhash{$version.':'.$key});
                   3493: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3494: 	        }
                   3495:             }
                   3496: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3497: 	 }
1.1       albertel 3498:       }
1.945     raeburn  3499:       my @currhidden = keys(%lasthidden);
1.596     albertel 3500:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3501:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3502:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3503:           if (%typeparts) {
                   3504:               my $hidden;
                   3505:               foreach my $id (@currhidden) {
                   3506:                   if ($key =~ /^\Q$id\E/) {
                   3507:                       $hidden = 1;
                   3508:                       last;
                   3509:                   }
                   3510:               }
                   3511:               if ($hidden) {
                   3512:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3513:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3514:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3515:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3516:                           $value = &$gradesub($value);
                   3517:                       }
                   3518:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3519:                   } else {
                   3520:                       $prevattempts.='<td>&nbsp;</td>';
                   3521:                   }
                   3522:               } else {
                   3523:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3524:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3525:                       $value = &$gradesub($value);
                   3526:                   }
                   3527:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3528:               }
                   3529:           } else {
                   3530: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3531: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3532:                   $value = &$gradesub($value);
                   3533:               }
                   3534: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3535:           }
1.16      harris41 3536:       }
1.596     albertel 3537:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3538:     } else {
1.596     albertel 3539:       $prevattempts=
                   3540: 	  &start_data_table().&start_data_table_row().
                   3541: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3542: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3543:     }
                   3544:   } else {
1.596     albertel 3545:     $prevattempts=
                   3546: 	  &start_data_table().&start_data_table_row().
                   3547: 	  '<td>'.&mt('No data.').'</td>'.
                   3548: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3549:   }
1.10      albertel 3550: }
                   3551: 
1.581     albertel 3552: sub format_previous_attempt_value {
                   3553:     my ($key,$value) = @_;
                   3554:     if ($key =~ /timestamp/) {
                   3555: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3556:     } elsif (ref($value) eq 'ARRAY') {
                   3557: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3558:     } elsif ($key =~ /answerstring$/) {
                   3559:         my %answers = &Apache::lonnet::str2hash($value);
                   3560:         my @anskeys = sort(keys(%answers));
                   3561:         if (@anskeys == 1) {
                   3562:             my $answer = $answers{$anskeys[0]};
                   3563:             if ($answer =~ m{\Q\0\E}) {
                   3564:                 $answer =~ s{\Q\0\E}{, }g;
                   3565:             }
                   3566:             my $tag_internal_answer_name = 'INTERNAL';
                   3567:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3568:                 $value = $answer; 
                   3569:             } else {
                   3570:                 $value = $anskeys[0].'='.$answer;
                   3571:             }
                   3572:         } else {
                   3573:             foreach my $ans (@anskeys) {
                   3574:                 my $answer = $answers{$ans};
                   3575:                 if ($answer =~ m{\Q\0\E}) {
                   3576:                     $answer =~ s{\Q\0\E}{, }g;
                   3577:                 }
                   3578:                 $value .=  $ans.'='.$answer.'<br />';;
                   3579:             } 
                   3580:         }
1.581     albertel 3581:     } else {
                   3582: 	$value = &unescape($value);
                   3583:     }
                   3584:     return $value;
                   3585: }
                   3586: 
                   3587: 
1.107     albertel 3588: sub relative_to_absolute {
                   3589:     my ($url,$output)=@_;
                   3590:     my $parser=HTML::TokeParser->new(\$output);
                   3591:     my $token;
                   3592:     my $thisdir=$url;
                   3593:     my @rlinks=();
                   3594:     while ($token=$parser->get_token) {
                   3595: 	if ($token->[0] eq 'S') {
                   3596: 	    if ($token->[1] eq 'a') {
                   3597: 		if ($token->[2]->{'href'}) {
                   3598: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3599: 		}
                   3600: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3601: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3602: 	    } elsif ($token->[1] eq 'base') {
                   3603: 		$thisdir=$token->[2]->{'href'};
                   3604: 	    }
                   3605: 	}
                   3606:     }
                   3607:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3608:     foreach my $link (@rlinks) {
1.726     raeburn  3609: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3610: 		($link=~/^\//) ||
                   3611: 		($link=~/^javascript:/i) ||
                   3612: 		($link=~/^mailto:/i) ||
                   3613: 		($link=~/^\#/)) {
                   3614: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3615: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3616: 	}
                   3617:     }
                   3618: # -------------------------------------------------- Deal with Applet codebases
                   3619:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3620:     return $output;
                   3621: }
                   3622: 
1.112     bowersj2 3623: =pod
                   3624: 
1.648     raeburn  3625: =item * &get_student_view()
1.112     bowersj2 3626: 
                   3627: show a snapshot of what student was looking at
                   3628: 
                   3629: =cut
                   3630: 
1.10      albertel 3631: sub get_student_view {
1.186     albertel 3632:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3633:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3634:   my (%form);
1.10      albertel 3635:   my @elements=('symb','courseid','domain','username');
                   3636:   foreach my $element (@elements) {
1.186     albertel 3637:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3638:   }
1.186     albertel 3639:   if (defined($moreenv)) {
                   3640:       %form=(%form,%{$moreenv});
                   3641:   }
1.236     albertel 3642:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3643:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3644:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3645:   $userview=~s/\<body[^\>]*\>//gi;
                   3646:   $userview=~s/\<\/body\>//gi;
                   3647:   $userview=~s/\<html\>//gi;
                   3648:   $userview=~s/\<\/html\>//gi;
                   3649:   $userview=~s/\<head\>//gi;
                   3650:   $userview=~s/\<\/head\>//gi;
                   3651:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3652:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3653:   if (wantarray) {
                   3654:      return ($userview,$response);
                   3655:   } else {
                   3656:      return $userview;
                   3657:   }
                   3658: }
                   3659: 
                   3660: sub get_student_view_with_retries {
                   3661:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3662: 
                   3663:     my $ok = 0;                 # True if we got a good response.
                   3664:     my $content;
                   3665:     my $response;
                   3666: 
                   3667:     # Try to get the student_view done. within the retries count:
                   3668:     
                   3669:     do {
                   3670:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3671:          $ok      = $response->is_success;
                   3672:          if (!$ok) {
                   3673:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3674:          }
                   3675:          $retries--;
                   3676:     } while (!$ok && ($retries > 0));
                   3677:     
                   3678:     if (!$ok) {
                   3679:        $content = '';          # On error return an empty content.
                   3680:     }
1.651     www      3681:     if (wantarray) {
                   3682:        return ($content, $response);
                   3683:     } else {
                   3684:        return $content;
                   3685:     }
1.11      albertel 3686: }
                   3687: 
1.112     bowersj2 3688: =pod
                   3689: 
1.648     raeburn  3690: =item * &get_student_answers() 
1.112     bowersj2 3691: 
                   3692: show a snapshot of how student was answering problem
                   3693: 
                   3694: =cut
                   3695: 
1.11      albertel 3696: sub get_student_answers {
1.100     sakharuk 3697:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      3698:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3699:   my (%moreenv);
1.11      albertel 3700:   my @elements=('symb','courseid','domain','username');
                   3701:   foreach my $element (@elements) {
1.186     albertel 3702:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3703:   }
1.186     albertel 3704:   $moreenv{'grade_target'}='answer';
                   3705:   %moreenv=(%form,%moreenv);
1.497     raeburn  3706:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   3707:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 3708:   return $userview;
1.1       albertel 3709: }
1.116     albertel 3710: 
                   3711: =pod
                   3712: 
                   3713: =item * &submlink()
                   3714: 
1.242     albertel 3715: Inputs: $text $uname $udom $symb $target
1.116     albertel 3716: 
                   3717: Returns: A link to grades.pm such as to see the SUBM view of a student
                   3718: 
                   3719: =cut
                   3720: 
                   3721: ###############################################
                   3722: sub submlink {
1.242     albertel 3723:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 3724:     if (!($uname && $udom)) {
                   3725: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3726: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 3727: 	if (!$symb) { $symb=$cursymb; }
                   3728:     }
1.254     matthew  3729:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3730:     $symb=&escape($symb);
1.960     bisitz   3731:     if ($target) { $target=" target=\"$target\""; }
                   3732:     return
                   3733:         '<a href="/adm/grades?command=submission'.
                   3734:         '&amp;symb='.$symb.
                   3735:         '&amp;student='.$uname.
                   3736:         '&amp;userdom='.$udom.'"'.
                   3737:         $target.'>'.$text.'</a>';
1.242     albertel 3738: }
                   3739: ##############################################
                   3740: 
                   3741: =pod
                   3742: 
                   3743: =item * &pgrdlink()
                   3744: 
                   3745: Inputs: $text $uname $udom $symb $target
                   3746: 
                   3747: Returns: A link to grades.pm such as to see the PGRD view of a student
                   3748: 
                   3749: =cut
                   3750: 
                   3751: ###############################################
                   3752: sub pgrdlink {
                   3753:     my $link=&submlink(@_);
                   3754:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   3755:     return $link;
                   3756: }
                   3757: ##############################################
                   3758: 
                   3759: =pod
                   3760: 
                   3761: =item * &pprmlink()
                   3762: 
                   3763: Inputs: $text $uname $udom $symb $target
                   3764: 
                   3765: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 3766: student and a specific resource
1.242     albertel 3767: 
                   3768: =cut
                   3769: 
                   3770: ###############################################
                   3771: sub pprmlink {
                   3772:     my ($text,$uname,$udom,$symb,$target)=@_;
                   3773:     if (!($uname && $udom)) {
                   3774: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3775: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 3776: 	if (!$symb) { $symb=$cursymb; }
                   3777:     }
1.254     matthew  3778:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3779:     $symb=&escape($symb);
1.242     albertel 3780:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 3781:     return '<a href="/adm/parmset?command=set&amp;'.
                   3782: 	'symb='.$symb.'&amp;uname='.$uname.
                   3783: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 3784: }
                   3785: ##############################################
1.37      matthew  3786: 
1.112     bowersj2 3787: =pod
                   3788: 
                   3789: =back
                   3790: 
                   3791: =cut
                   3792: 
1.37      matthew  3793: ###############################################
1.51      www      3794: 
                   3795: 
                   3796: sub timehash {
1.687     raeburn  3797:     my ($thistime) = @_;
                   3798:     my $timezone = &Apache::lonlocal::gettimezone();
                   3799:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   3800:                      ->set_time_zone($timezone);
                   3801:     my $wday = $dt->day_of_week();
                   3802:     if ($wday == 7) { $wday = 0; }
                   3803:     return ( 'second' => $dt->second(),
                   3804:              'minute' => $dt->minute(),
                   3805:              'hour'   => $dt->hour(),
                   3806:              'day'     => $dt->day_of_month(),
                   3807:              'month'   => $dt->month(),
                   3808:              'year'    => $dt->year(),
                   3809:              'weekday' => $wday,
                   3810:              'dayyear' => $dt->day_of_year(),
                   3811:              'dlsav'   => $dt->is_dst() );
1.51      www      3812: }
                   3813: 
1.370     www      3814: sub utc_string {
                   3815:     my ($date)=@_;
1.371     www      3816:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      3817: }
                   3818: 
1.51      www      3819: sub maketime {
                   3820:     my %th=@_;
1.687     raeburn  3821:     my ($epoch_time,$timezone,$dt);
                   3822:     $timezone = &Apache::lonlocal::gettimezone();
                   3823:     eval {
                   3824:         $dt = DateTime->new( year   => $th{'year'},
                   3825:                              month  => $th{'month'},
                   3826:                              day    => $th{'day'},
                   3827:                              hour   => $th{'hour'},
                   3828:                              minute => $th{'minute'},
                   3829:                              second => $th{'second'},
                   3830:                              time_zone => $timezone,
                   3831:                          );
                   3832:     };
                   3833:     if (!$@) {
                   3834:         $epoch_time = $dt->epoch;
                   3835:         if ($epoch_time) {
                   3836:             return $epoch_time;
                   3837:         }
                   3838:     }
1.51      www      3839:     return POSIX::mktime(
                   3840:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      3841:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      3842: }
                   3843: 
                   3844: #########################################
1.51      www      3845: 
                   3846: sub findallcourses {
1.482     raeburn  3847:     my ($roles,$uname,$udom) = @_;
1.355     albertel 3848:     my %roles;
                   3849:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 3850:     my %courses;
1.51      www      3851:     my $now=time;
1.482     raeburn  3852:     if (!defined($uname)) {
                   3853:         $uname = $env{'user.name'};
                   3854:     }
                   3855:     if (!defined($udom)) {
                   3856:         $udom = $env{'user.domain'};
                   3857:     }
                   3858:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.982     raeburn  3859:         my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
                   3860:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,
                   3861:                                               $extra);
1.482     raeburn  3862:         if (!%roles) {
                   3863:             %roles = (
                   3864:                        cc => 1,
1.907     raeburn  3865:                        co => 1,
1.482     raeburn  3866:                        in => 1,
                   3867:                        ep => 1,
                   3868:                        ta => 1,
                   3869:                        cr => 1,
                   3870:                        st => 1,
                   3871:              );
                   3872:         }
                   3873:         foreach my $entry (keys(%roleshash)) {
                   3874:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   3875:             if ($trole =~ /^cr/) { 
                   3876:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   3877:             } else {
                   3878:                 next if (!exists($roles{$trole}));
                   3879:             }
                   3880:             if ($tend) {
                   3881:                 next if ($tend < $now);
                   3882:             }
                   3883:             if ($tstart) {
                   3884:                 next if ($tstart > $now);
                   3885:             }
                   3886:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
                   3887:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
                   3888:             if ($secpart eq '') {
                   3889:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   3890:                 $sec = 'none';
                   3891:                 $realsec = '';
                   3892:             } else {
                   3893:                 $cnum = $cnumpart;
                   3894:                 ($sec,$role) = split(/_/,$secpart);
                   3895:                 $realsec = $sec;
1.490     raeburn  3896:             }
1.482     raeburn  3897:             $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
                   3898:         }
                   3899:     } else {
                   3900:         foreach my $key (keys(%env)) {
1.483     albertel 3901: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   3902:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  3903: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   3904: 	        next if ($role eq 'ca' || $role eq 'aa');
                   3905: 	        next if (%roles && !exists($roles{$role}));
                   3906: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   3907:                 my $active=1;
                   3908:                 if ($starttime) {
                   3909: 		    if ($now<$starttime) { $active=0; }
                   3910:                 }
                   3911:                 if ($endtime) {
                   3912:                     if ($now>$endtime) { $active=0; }
                   3913:                 }
                   3914:                 if ($active) {
                   3915:                     if ($sec eq '') {
                   3916:                         $sec = 'none';
                   3917:                     }
                   3918:                     $courses{$cdom.'_'.$cnum}{$sec} = 
                   3919:                                      $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
1.474     raeburn  3920:                 }
                   3921:             }
1.51      www      3922:         }
                   3923:     }
1.474     raeburn  3924:     return %courses;
1.51      www      3925: }
1.37      matthew  3926: 
1.54      www      3927: ###############################################
1.474     raeburn  3928: 
                   3929: sub blockcheck {
1.482     raeburn  3930:     my ($setters,$activity,$uname,$udom) = @_;
1.490     raeburn  3931: 
                   3932:     if (!defined($udom)) {
                   3933:         $udom = $env{'user.domain'};
                   3934:     }
                   3935:     if (!defined($uname)) {
                   3936:         $uname = $env{'user.name'};
                   3937:     }
                   3938: 
                   3939:     # If uname and udom are for a course, check for blocks in the course.
                   3940: 
                   3941:     if (&Apache::lonnet::is_course($udom,$uname)) {
                   3942:         my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
1.502     raeburn  3943:         my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
1.490     raeburn  3944:         return ($startblock,$endblock);
                   3945:     }
1.474     raeburn  3946: 
1.502     raeburn  3947:     my $startblock = 0;
                   3948:     my $endblock = 0;
1.482     raeburn  3949:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  3950: 
1.490     raeburn  3951:     # If uname is for a user, and activity is course-specific, i.e.,
                   3952:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  3953: 
1.490     raeburn  3954:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   3955:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   3956:         foreach my $key (keys(%live_courses)) {
                   3957:             if ($key ne $env{'request.course.id'}) {
                   3958:                 delete($live_courses{$key});
                   3959:             }
                   3960:         }
                   3961:     }
                   3962: 
                   3963:     my $otheruser = 0;
                   3964:     my %own_courses;
                   3965:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   3966:         # Resource belongs to user other than current user.
                   3967:         $otheruser = 1;
                   3968:         # Gather courses for current user
                   3969:         %own_courses = 
                   3970:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   3971:     }
                   3972: 
                   3973:     # Gather active course roles - course coordinator, instructor, 
                   3974:     # exam proctor, ta, student, or custom role.
1.474     raeburn  3975: 
                   3976:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  3977:         my ($cdom,$cnum);
                   3978:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   3979:             $cdom = $env{'course.'.$course.'.domain'};
                   3980:             $cnum = $env{'course.'.$course.'.num'};
                   3981:         } else {
1.490     raeburn  3982:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  3983:         }
                   3984:         my $no_ownblock = 0;
                   3985:         my $no_userblock = 0;
1.533     raeburn  3986:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  3987:             # Check if current user has 'evb' priv for this
                   3988:             if (defined($own_courses{$course})) {
                   3989:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   3990:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   3991:                     if ($sec ne 'none') {
                   3992:                         $checkrole .= '/'.$sec;
                   3993:                     }
                   3994:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   3995:                         $no_ownblock = 1;
                   3996:                         last;
                   3997:                     }
                   3998:                 }
                   3999:             }
                   4000:             # if they have 'evb' priv and are currently not playing student
                   4001:             next if (($no_ownblock) &&
                   4002:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4003:         }
1.474     raeburn  4004:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4005:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4006:             if ($sec ne 'none') {
1.482     raeburn  4007:                 $checkrole .= '/'.$sec;
1.474     raeburn  4008:             }
1.490     raeburn  4009:             if ($otheruser) {
                   4010:                 # Resource belongs to user other than current user.
                   4011:                 # Assemble privs for that user, and check for 'evb' priv.
1.482     raeburn  4012:                 my ($trole,$tdom,$tnum,$tsec);
                   4013:                 my $entry = $live_courses{$course}{$sec};
                   4014:                 if ($entry =~ /^cr/) {
                   4015:                     ($trole,$tdom,$tnum,$tsec) = 
                   4016:                       ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4017:                 } else {
                   4018:                     ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4019:                 }
                   4020:                 my ($spec,$area,$trest,%allroles,%userroles);
                   4021:                 $area = '/'.$tdom.'/'.$tnum;
                   4022:                 $trest = $tnum;
                   4023:                 if ($tsec ne '') {
                   4024:                     $area .= '/'.$tsec;
                   4025:                     $trest .= '/'.$tsec;
                   4026:                 }
                   4027:                 $spec = $trole.'.'.$area;
                   4028:                 if ($trole =~ /^cr/) {
                   4029:                     &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4030:                                                       $tdom,$spec,$trest,$area);
                   4031:                 } else {
                   4032:                     &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4033:                                                        $tdom,$spec,$trest,$area);
                   4034:                 }
                   4035:                 my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.486     raeburn  4036:                 if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4037:                     if ($1) {
                   4038:                         $no_userblock = 1;
                   4039:                         last;
                   4040:                     }
                   4041:                 }
1.490     raeburn  4042:             } else {
                   4043:                 # Resource belongs to current user
                   4044:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4045:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4046:                     $no_ownblock = 1;
                   4047:                     last;
                   4048:                 }
1.474     raeburn  4049:             }
                   4050:         }
                   4051:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4052:         next if (($no_ownblock) &&
1.491     albertel 4053:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4054:         next if ($no_userblock);
1.474     raeburn  4055: 
1.866     kalberla 4056:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4057:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4058:         
                   4059:         my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
                   4060:         if (($start != 0) && 
                   4061:             (($startblock == 0) || ($startblock > $start))) {
                   4062:             $startblock = $start;
                   4063:         }
                   4064:         if (($end != 0)  &&
                   4065:             (($endblock == 0) || ($endblock < $end))) {
                   4066:             $endblock = $end;
                   4067:         }
1.490     raeburn  4068:     }
                   4069:     return ($startblock,$endblock);
                   4070: }
                   4071: 
                   4072: sub get_blocks {
                   4073:     my ($setters,$activity,$cdom,$cnum) = @_;
                   4074:     my $startblock = 0;
                   4075:     my $endblock = 0;
                   4076:     my $course = $cdom.'_'.$cnum;
                   4077:     $setters->{$course} = {};
                   4078:     $setters->{$course}{'staff'} = [];
                   4079:     $setters->{$course}{'times'} = [];
                   4080:     my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
                   4081:     foreach my $record (keys(%records)) {
                   4082:         my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
                   4083:         if ($start <= time && $end >= time) {
                   4084:             my ($staff_name,$staff_dom,$title,$blocks) =
                   4085:                 &parse_block_record($records{$record});
                   4086:             if ($blocks->{$activity} eq 'on') {
                   4087:                 push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4088:                 push(@{$$setters{$course}{'times'}}, [$start,$end]);
1.491     albertel 4089:                 if ( ($startblock == 0) || ($startblock > $start) ) {
                   4090:                     $startblock = $start;
1.490     raeburn  4091:                 }
1.491     albertel 4092:                 if ( ($endblock == 0) || ($endblock < $end) ) {
                   4093:                     $endblock = $end;
1.474     raeburn  4094:                 }
                   4095:             }
                   4096:         }
                   4097:     }
                   4098:     return ($startblock,$endblock);
                   4099: }
                   4100: 
                   4101: sub parse_block_record {
                   4102:     my ($record) = @_;
                   4103:     my ($setuname,$setudom,$title,$blocks);
                   4104:     if (ref($record) eq 'HASH') {
                   4105:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4106:         $title = &unescape($record->{'event'});
                   4107:         $blocks = $record->{'blocks'};
                   4108:     } else {
                   4109:         my @data = split(/:/,$record,3);
                   4110:         if (scalar(@data) eq 2) {
                   4111:             $title = $data[1];
                   4112:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4113:         } else {
                   4114:             ($setuname,$setudom,$title) = @data;
                   4115:         }
                   4116:         $blocks = { 'com' => 'on' };
                   4117:     }
                   4118:     return ($setuname,$setudom,$title,$blocks);
                   4119: }
                   4120: 
1.854     kalberla 4121: sub blocking_status {
                   4122:   my ($activity,$uname,$udom) = @_;
1.867     kalberla 4123:   my %setters;
1.890     droeschl 4124: 
                   4125:   # check for active blocking
1.867     kalberla 4126:   my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
1.854     kalberla 4127: 
1.890     droeschl 4128:   my $blocked = $startblock && $endblock ? 1 : 0;
                   4129: 
                   4130:   # caller just wants to know whether a block is active
                   4131:   if (!wantarray) { return $blocked; }
                   4132: 
                   4133:   # build a link to a popup window containing the details
                   4134:   my $querystring  = "?activity=$activity";
                   4135:   # $uname and $udom decide whose portfolio the user is trying to look at
                   4136:      $querystring .= "&amp;udom=$udom"      if $udom;
                   4137:      $querystring .= "&amp;uname=$uname"    if $uname;
                   4138: 
                   4139:   my $output .= <<'END_MYBLOCK';
1.854     kalberla 4140:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4141:         var options = "width=" + w + ",height=" + h + ",";
                   4142:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4143:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4144:         var newWin = window.open(url, wdwName, options);
                   4145:         newWin.focus();
                   4146:     }
1.890     droeschl 4147: END_MYBLOCK
1.854     kalberla 4148: 
1.890     droeschl 4149:   $output = Apache::lonhtmlcommon::scripttag($output);
                   4150:   
1.854     kalberla 4151:   my $popupUrl = "/adm/blockingstatus/$querystring";
1.890     droeschl 4152:   my $text = mt('Communication Blocked');
                   4153: 
1.867     kalberla 4154:   $output .= <<"END_BLOCK";
                   4155: <div class='LC_comblock'>
1.869     kalberla 4156:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4157:   title='$text'>
                   4158:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4159:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4160:   title='$text'>$text</a>
1.867     kalberla 4161: </div>
                   4162: 
                   4163: END_BLOCK
1.474     raeburn  4164: 
1.854     kalberla 4165:   return ($blocked, $output);
                   4166: }
1.490     raeburn  4167: 
1.60      matthew  4168: ###############################################
                   4169: 
1.682     raeburn  4170: sub check_ip_acc {
                   4171:     my ($acc)=@_;
                   4172:     &Apache::lonxml::debug("acc is $acc");
                   4173:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4174:         return 1;
                   4175:     }
                   4176:     my $allowed=0;
                   4177:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4178: 
                   4179:     my $name;
                   4180:     foreach my $pattern (split(',',$acc)) {
                   4181:         $pattern =~ s/^\s*//;
                   4182:         $pattern =~ s/\s*$//;
                   4183:         if ($pattern =~ /\*$/) {
                   4184:             #35.8.*
                   4185:             $pattern=~s/\*//;
                   4186:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4187:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4188:             #35.8.3.[34-56]
                   4189:             my $low=$2;
                   4190:             my $high=$3;
                   4191:             $pattern=$1;
                   4192:             if ($ip =~ /^\Q$pattern\E/) {
                   4193:                 my $last=(split(/\./,$ip))[3];
                   4194:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4195:             }
                   4196:         } elsif ($pattern =~ /^\*/) {
                   4197:             #*.msu.edu
                   4198:             $pattern=~s/\*//;
                   4199:             if (!defined($name)) {
                   4200:                 use Socket;
                   4201:                 my $netaddr=inet_aton($ip);
                   4202:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4203:             }
                   4204:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4205:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4206:             #127.0.0.1
                   4207:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4208:         } else {
                   4209:             #some.name.com
                   4210:             if (!defined($name)) {
                   4211:                 use Socket;
                   4212:                 my $netaddr=inet_aton($ip);
                   4213:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4214:             }
                   4215:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4216:         }
                   4217:         if ($allowed) { last; }
                   4218:     }
                   4219:     return $allowed;
                   4220: }
                   4221: 
                   4222: ###############################################
                   4223: 
1.60      matthew  4224: =pod
                   4225: 
1.112     bowersj2 4226: =head1 Domain Template Functions
                   4227: 
                   4228: =over 4
                   4229: 
                   4230: =item * &determinedomain()
1.60      matthew  4231: 
                   4232: Inputs: $domain (usually will be undef)
                   4233: 
1.63      www      4234: Returns: Determines which domain should be used for designs
1.60      matthew  4235: 
                   4236: =cut
1.54      www      4237: 
1.60      matthew  4238: ###############################################
1.63      www      4239: sub determinedomain {
                   4240:     my $domain=shift;
1.531     albertel 4241:     if (! $domain) {
1.60      matthew  4242:         # Determine domain if we have not been given one
1.893     raeburn  4243:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4244:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4245:         if ($env{'request.role.domain'}) { 
                   4246:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4247:         }
                   4248:     }
1.63      www      4249:     return $domain;
                   4250: }
                   4251: ###############################################
1.517     raeburn  4252: 
1.518     albertel 4253: sub devalidate_domconfig_cache {
                   4254:     my ($udom)=@_;
                   4255:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4256: }
                   4257: 
                   4258: # ---------------------- Get domain configuration for a domain
                   4259: sub get_domainconf {
                   4260:     my ($udom) = @_;
                   4261:     my $cachetime=1800;
                   4262:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4263:     if (defined($cached)) { return %{$result}; }
                   4264: 
                   4265:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4266: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4267:     my (%designhash,%legacy);
1.518     albertel 4268:     if (keys(%domconfig) > 0) {
                   4269:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4270:             if (keys(%{$domconfig{'login'}})) {
                   4271:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4272:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4273:                         if ($key eq 'loginvia') {
                   4274:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
                   4275:                                 my @ids = &Apache::lonnet::current_machine_ids();
                   4276:                                 foreach my $hostname (@ids) {
1.948     raeburn  4277:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4278:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4279:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4280:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4281:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4282: 
                   4283:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4284:                                             } else {
                   4285:                                                  $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                   4286:                                             }
                   4287:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4288:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4289:                                             }
1.946     raeburn  4290:                                         }
                   4291:                                     }
                   4292:                                 }
                   4293:                             }
                   4294:                         } else {
                   4295:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4296:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4297:                                     $domconfig{'login'}{$key}{$img};
                   4298:                             }
1.699     raeburn  4299:                         }
                   4300:                     } else {
                   4301:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4302:                     }
1.632     raeburn  4303:                 }
                   4304:             } else {
                   4305:                 $legacy{'login'} = 1;
1.518     albertel 4306:             }
1.632     raeburn  4307:         } else {
                   4308:             $legacy{'login'} = 1;
1.518     albertel 4309:         }
                   4310:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4311:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4312:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4313:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4314:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4315:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4316:                         }
1.518     albertel 4317:                     }
                   4318:                 }
1.632     raeburn  4319:             } else {
                   4320:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4321:             }
1.632     raeburn  4322:         } else {
                   4323:             $legacy{'rolecolors'} = 1;
1.518     albertel 4324:         }
1.948     raeburn  4325:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4326:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4327:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4328:             }
                   4329:         }
1.632     raeburn  4330:         if (keys(%legacy) > 0) {
                   4331:             my %legacyhash = &get_legacy_domconf($udom);
                   4332:             foreach my $item (keys(%legacyhash)) {
                   4333:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4334:                     if ($legacy{'login'}) { 
                   4335:                         $designhash{$item} = $legacyhash{$item};
                   4336:                     }
                   4337:                 } else {
                   4338:                     if ($legacy{'rolecolors'}) {
                   4339:                         $designhash{$item} = $legacyhash{$item};
                   4340:                     }
1.518     albertel 4341:                 }
                   4342:             }
                   4343:         }
1.632     raeburn  4344:     } else {
                   4345:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4346:     }
                   4347:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4348: 				  $cachetime);
                   4349:     return %designhash;
                   4350: }
                   4351: 
1.632     raeburn  4352: sub get_legacy_domconf {
                   4353:     my ($udom) = @_;
                   4354:     my %legacyhash;
                   4355:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4356:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4357:     if (-e $designfile) {
                   4358:         if ( open (my $fh,"<$designfile") ) {
                   4359:             while (my $line = <$fh>) {
                   4360:                 next if ($line =~ /^\#/);
                   4361:                 chomp($line);
                   4362:                 my ($key,$val)=(split(/\=/,$line));
                   4363:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4364:             }
                   4365:             close($fh);
                   4366:         }
                   4367:     }
                   4368:     if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
                   4369:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4370:     }
                   4371:     return %legacyhash;
                   4372: }
                   4373: 
1.63      www      4374: =pod
                   4375: 
1.112     bowersj2 4376: =item * &domainlogo()
1.63      www      4377: 
                   4378: Inputs: $domain (usually will be undef)
                   4379: 
                   4380: Returns: A link to a domain logo, if the domain logo exists.
                   4381: If the domain logo does not exist, a description of the domain.
                   4382: 
                   4383: =cut
1.112     bowersj2 4384: 
1.63      www      4385: ###############################################
                   4386: sub domainlogo {
1.517     raeburn  4387:     my $domain = &determinedomain(shift);
1.518     albertel 4388:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4389:     # See if there is a logo
                   4390:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4391:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4392:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4393: 	    if ($imgsrc =~ m{^/res/}) {
                   4394: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4395: 		&Apache::lonnet::repcopy($local_name);
                   4396: 	    }
                   4397: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4398:         } 
                   4399:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4400:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4401:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4402:     } else {
1.60      matthew  4403:         return '';
1.59      www      4404:     }
                   4405: }
1.63      www      4406: ##############################################
                   4407: 
                   4408: =pod
                   4409: 
1.112     bowersj2 4410: =item * &designparm()
1.63      www      4411: 
                   4412: Inputs: $which parameter; $domain (usually will be undef)
                   4413: 
                   4414: Returns: value of designparamter $which
                   4415: 
                   4416: =cut
1.112     bowersj2 4417: 
1.397     albertel 4418: 
1.400     albertel 4419: ##############################################
1.397     albertel 4420: sub designparm {
                   4421:     my ($which,$domain)=@_;
                   4422:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4423:         return $env{'environment.color.'.$which};
1.96      www      4424:     }
1.63      www      4425:     $domain=&determinedomain($domain);
1.518     albertel 4426:     my %domdesign = &get_domainconf($domain);
1.520     raeburn  4427:     my $output;
1.517     raeburn  4428:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4429:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4430:     } else {
1.520     raeburn  4431:         $output = $defaultdesign{$which};
                   4432:     }
                   4433:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4434:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4435:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4436:             if ($output =~ m{^/res/}) {
                   4437:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4438:                 &Apache::lonnet::repcopy($local_name);
                   4439:             }
1.520     raeburn  4440:             $output = &lonhttpdurl($output);
                   4441:         }
1.63      www      4442:     }
1.520     raeburn  4443:     return $output;
1.63      www      4444: }
1.59      www      4445: 
1.822     bisitz   4446: ##############################################
                   4447: =pod
                   4448: 
1.832     bisitz   4449: =item * &authorspace()
                   4450: 
                   4451: Inputs: ./.
                   4452: 
                   4453: Returns: Path to the Construction Space of the current user's
                   4454:          accessed author space
                   4455:          The author space will be that of the current user
                   4456:          when accessing the own author space
                   4457:          and that of the co-author/assistent co-author
                   4458:          when accessing the co-author's/assistent co-author's
                   4459:          space
                   4460: 
                   4461: =cut
                   4462: 
                   4463: sub authorspace {
                   4464:     my $caname = '';
                   4465:     if ($env{'request.role'} =~ /^ca|^aa/) {
                   4466:         (undef,$caname) =
                   4467:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
                   4468:     } else {
                   4469:         $caname = $env{'user.name'};
                   4470:     }
                   4471:     return '/priv/'.$caname.'/';
                   4472: }
                   4473: 
                   4474: ##############################################
                   4475: =pod
                   4476: 
1.822     bisitz   4477: =item * &head_subbox()
                   4478: 
                   4479: Inputs: $content (contains HTML code with page functions, etc.)
                   4480: 
                   4481: Returns: HTML div with $content
                   4482:          To be included in page header
                   4483: 
                   4484: =cut
                   4485: 
                   4486: sub head_subbox {
                   4487:     my ($content)=@_;
                   4488:     my $output =
1.993     raeburn  4489:         '<div class="LC_head_subbox">'
1.822     bisitz   4490:        .$content
                   4491:        .'</div>'
                   4492: }
                   4493: 
                   4494: ##############################################
                   4495: =pod
                   4496: 
                   4497: =item * &CSTR_pageheader()
                   4498: 
                   4499: Inputs: ./.
                   4500: 
                   4501: Returns: HTML div with CSTR path and recent box
                   4502:          To be included on Construction Space pages
                   4503: 
                   4504: =cut
                   4505: 
                   4506: sub CSTR_pageheader {
                   4507:     # this is for resources; directories have customtitle, and crumbs
                   4508:             # and select recent are created in lonpubdir.pm  
                   4509:     my ($uname,$thisdisfn)=
                   4510:         ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
                   4511:     my $formaction='/priv/'.$uname.'/'.$thisdisfn;
                   4512:     $formaction=~s/\/+/\//g;
                   4513: 
                   4514:     my $parentpath = '';
                   4515:     my $lastitem = '';
                   4516:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4517:         $parentpath = $1;
                   4518:         $lastitem = $2;
                   4519:     } else {
                   4520:         $lastitem = $thisdisfn;
                   4521:     }
1.921     bisitz   4522: 
                   4523:     my $output =
1.822     bisitz   4524:          '<div>'
                   4525:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
                   4526:         .'<b>'.&mt('Construction Space:').'</b> '
                   4527:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   4528:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
                   4529:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv',undef,undef);
                   4530: 
                   4531:     if ($lastitem) {
                   4532:         $output .=
                   4533:              '<span class="LC_filename">'
                   4534:             .$lastitem
                   4535:             .'</span>';
                   4536:     }
                   4537:     $output .=
                   4538:          '<br />'
1.822     bisitz   4539:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   4540:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   4541:         .'</form>'
                   4542:         .&Apache::lonmenu::constspaceform()
                   4543:         .'</div>';
1.921     bisitz   4544: 
                   4545:     return $output;
1.822     bisitz   4546: }
                   4547: 
1.60      matthew  4548: ###############################################
                   4549: ###############################################
                   4550: 
                   4551: =pod
                   4552: 
1.112     bowersj2 4553: =back
                   4554: 
1.549     albertel 4555: =head1 HTML Helpers
1.112     bowersj2 4556: 
                   4557: =over 4
                   4558: 
                   4559: =item * &bodytag()
1.60      matthew  4560: 
                   4561: Returns a uniform header for LON-CAPA web pages.
                   4562: 
                   4563: Inputs: 
                   4564: 
1.112     bowersj2 4565: =over 4
                   4566: 
                   4567: =item * $title, A title to be displayed on the page.
                   4568: 
                   4569: =item * $function, the current role (can be undef).
                   4570: 
                   4571: =item * $addentries, extra parameters for the <body> tag.
                   4572: 
                   4573: =item * $bodyonly, if defined, only return the <body> tag.
                   4574: 
                   4575: =item * $domain, if defined, force a given domain.
                   4576: 
                   4577: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      4578:             text interface only)
1.60      matthew  4579: 
1.814     bisitz   4580: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   4581:                      navigational links
1.317     albertel 4582: 
1.338     albertel 4583: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   4584: 
1.460     albertel 4585: =item * $args, optional argument valid values are
                   4586:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 4587:             inherit_jsmath -> when creating popup window in a page,
                   4588:                               should it have jsmath forced on by the
                   4589:                               current page
1.460     albertel 4590: 
1.112     bowersj2 4591: =back
                   4592: 
1.60      matthew  4593: Returns: A uniform header for LON-CAPA web pages.  
                   4594: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   4595: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   4596: other decorations will be returned.
                   4597: 
                   4598: =cut
                   4599: 
1.54      www      4600: sub bodytag {
1.831     bisitz   4601:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.962     droeschl 4602:         $no_nav_bar,$bgcolor,$args)=@_;
1.339     albertel 4603: 
1.954     raeburn  4604:     my $public;
                   4605:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   4606:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   4607:         $public = 1;
                   4608:     }
1.460     albertel 4609:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339     albertel 4610: 
1.183     matthew  4611:     $function = &get_users_function() if (!$function);
1.339     albertel 4612:     my $img =    &designparm($function.'.img',$domain);
                   4613:     my $font =   &designparm($function.'.font',$domain);
                   4614:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   4615: 
1.803     bisitz   4616:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 4617: 		   'bgcolor' => $pgbg,
1.339     albertel 4618: 		   'text'    => $font,
                   4619:                    'alink'   => &designparm($function.'.alink',$domain),
                   4620: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   4621: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 4622:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 4623: 
1.63      www      4624:  # role and realm
1.378     raeburn  4625:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   4626:     if ($role  eq 'ca') {
1.479     albertel 4627:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 4628:         $realm = &plainname($rname,$rdom);
1.378     raeburn  4629:     } 
1.55      www      4630: # realm
1.258     albertel 4631:     if ($env{'request.course.id'}) {
1.378     raeburn  4632:         if ($env{'request.role'} !~ /^cr/) {
                   4633:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   4634:         }
1.898     raeburn  4635:         if ($env{'request.course.sec'}) {
                   4636:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   4637:         }   
1.359     albertel 4638: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  4639:     } else {
                   4640:         $role = &Apache::lonnet::plaintext($role);
1.54      www      4641:     }
1.433     albertel 4642: 
1.359     albertel 4643:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 4644: 
1.438     albertel 4645:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 4646: 
1.101     www      4647: # construct main body tag
1.359     albertel 4648:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 4649: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 4650: 
1.530     albertel 4651:     if ($bodyonly) {
1.60      matthew  4652:         return $bodytag;
1.798     tempelho 4653:     } 
1.359     albertel 4654: 
1.410     albertel 4655:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.954     raeburn  4656:     if ($public) {
1.433     albertel 4657: 	undef($role);
1.434     albertel 4658:     } else {
                   4659: 	$name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
1.433     albertel 4660:     }
1.359     albertel 4661:     
1.762     bisitz   4662:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 4663:     #
                   4664:     # Extra info if you are the DC
                   4665:     my $dc_info = '';
                   4666:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   4667:                         $env{'course.'.$env{'request.course.id'}.
                   4668:                                  '.domain'}.'/'})) {
                   4669:         my $cid = $env{'request.course.id'};
1.917     raeburn  4670:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      4671:         $dc_info =~ s/\s+$//;
1.359     albertel 4672:     }
                   4673: 
1.898     raeburn  4674:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853     droeschl 4675:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   4676: 
1.916     droeschl 4677:         if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') { 
                   4678:             return $bodytag; 
                   4679:         } 
1.903     droeschl 4680: 
                   4681:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   4682: 
                   4683:         #    if ($env{'request.state'} eq 'construct') {
                   4684:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   4685:         #    }
                   4686: 
1.359     albertel 4687: 
                   4688: 
1.916     droeschl 4689:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  4690:              if ($dc_info) {
                   4691:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   4692:              }
1.916     droeschl 4693:              $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
                   4694:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 4695:             return $bodytag;
                   4696:         }
1.894     droeschl 4697: 
1.927     raeburn  4698:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
                   4699:             $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>|;
                   4700:         }
1.916     droeschl 4701: 
1.903     droeschl 4702:         $bodytag .= Apache::lonhtmlcommon::scripttag(
                   4703:             Apache::lonmenu::utilityfunctions(), 'start');
1.816     bisitz   4704: 
1.903     droeschl 4705:         $bodytag .= Apache::lonmenu::primary_menu();
1.852     droeschl 4706: 
1.917     raeburn  4707:         if ($dc_info) {
                   4708:             $dc_info = &dc_courseid_toggle($dc_info);
                   4709:         }
                   4710:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 4711: 
1.903     droeschl 4712:         #don't show menus for public users
1.954     raeburn  4713:         if (!$public){
1.903     droeschl 4714:             $bodytag .= Apache::lonmenu::secondary_menu();
                   4715:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  4716:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   4717:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 4718:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  4719:                                 $args->{'bread_crumbs'});
                   4720:             } elsif ($forcereg) { 
                   4721:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg);
                   4722:             }
1.903     droeschl 4723:         }else{
                   4724:             # this is to seperate menu from content when there's no secondary
                   4725:             # menu. Especially needed for public accessible ressources.
                   4726:             $bodytag .= '<hr style="clear:both" />';
                   4727:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  4728:         }
1.903     droeschl 4729: 
1.235     raeburn  4730:         return $bodytag;
1.182     matthew  4731: }
                   4732: 
1.917     raeburn  4733: sub dc_courseid_toggle {
                   4734:     my ($dc_info) = @_;
1.980     raeburn  4735:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.917     raeburn  4736:            '<a href="javascript:showCourseID();">'.
                   4737:            &mt('(More ...)').'</a></span>'.
                   4738:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   4739: }
                   4740: 
1.330     albertel 4741: sub make_attr_string {
                   4742:     my ($register,$attr_ref) = @_;
                   4743: 
                   4744:     if ($attr_ref && !ref($attr_ref)) {
                   4745: 	die("addentries Must be a hash ref ".
                   4746: 	    join(':',caller(1))." ".
                   4747: 	    join(':',caller(0))." ");
                   4748:     }
                   4749: 
                   4750:     if ($register) {
1.339     albertel 4751: 	my ($on_load,$on_unload);
                   4752: 	foreach my $key (keys(%{$attr_ref})) {
                   4753: 	    if      (lc($key) eq 'onload') {
                   4754: 		$on_load.=$attr_ref->{$key}.';';
                   4755: 		delete($attr_ref->{$key});
                   4756: 
                   4757: 	    } elsif (lc($key) eq 'onunload') {
                   4758: 		$on_unload.=$attr_ref->{$key}.';';
                   4759: 		delete($attr_ref->{$key});
                   4760: 	    }
                   4761: 	}
1.953     droeschl 4762: 	$attr_ref->{'onload'}  = $on_load;
                   4763: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 4764:     }
1.339     albertel 4765: 
1.330     albertel 4766:     my $attr_string;
                   4767:     foreach my $attr (keys(%$attr_ref)) {
                   4768: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   4769:     }
                   4770:     return $attr_string;
                   4771: }
                   4772: 
                   4773: 
1.182     matthew  4774: ###############################################
1.251     albertel 4775: ###############################################
                   4776: 
                   4777: =pod
                   4778: 
                   4779: =item * &endbodytag()
                   4780: 
                   4781: Returns a uniform footer for LON-CAPA web pages.
                   4782: 
1.635     raeburn  4783: Inputs: 1 - optional reference to an args hash
                   4784: If in the hash, key for noredirectlink has a value which evaluates to true,
                   4785: a 'Continue' link is not displayed if the page contains an
                   4786: internal redirect in the <head></head> section,
                   4787: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 4788: 
                   4789: =cut
                   4790: 
                   4791: sub endbodytag {
1.635     raeburn  4792:     my ($args) = @_;
1.251     albertel 4793:     my $endbodytag='</body>';
1.269     albertel 4794:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 4795:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  4796:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   4797: 	    $endbodytag=
                   4798: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   4799: 	        &mt('Continue').'</a>'.
                   4800: 	        $endbodytag;
                   4801:         }
1.315     albertel 4802:     }
1.251     albertel 4803:     return $endbodytag;
                   4804: }
                   4805: 
1.352     albertel 4806: =pod
                   4807: 
                   4808: =item * &standard_css()
                   4809: 
                   4810: Returns a style sheet
                   4811: 
                   4812: Inputs: (all optional)
                   4813:             domain         -> force to color decorate a page for a specific
                   4814:                                domain
                   4815:             function       -> force usage of a specific rolish color scheme
                   4816:             bgcolor        -> override the default page bgcolor
                   4817: 
                   4818: =cut
                   4819: 
1.343     albertel 4820: sub standard_css {
1.345     albertel 4821:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 4822:     $function  = &get_users_function() if (!$function);
                   4823:     my $img    = &designparm($function.'.img',   $domain);
                   4824:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   4825:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 4826:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 4827: #second colour for later usage
1.345     albertel 4828:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 4829:     my $pgbg_or_bgcolor =
                   4830: 	         $bgcolor ||
1.352     albertel 4831: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 4832:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 4833:     my $alink  = &designparm($function.'.alink', $domain);
                   4834:     my $vlink  = &designparm($function.'.vlink', $domain);
                   4835:     my $link   = &designparm($function.'.link',  $domain);
                   4836: 
1.602     albertel 4837:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 4838:     my $mono                 = 'monospace';
1.850     bisitz   4839:     my $data_table_head      = $sidebg;
                   4840:     my $data_table_light     = '#FAFAFA';
                   4841:     my $data_table_dark      = '#F0F0F0';
1.470     banghart 4842:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 4843:     my $data_table_highlight = '#FFFF00';
1.352     albertel 4844:     my $mail_new             = '#FFBB77';
                   4845:     my $mail_new_hover       = '#DD9955';
                   4846:     my $mail_read            = '#BBBB77';
                   4847:     my $mail_read_hover      = '#999944';
                   4848:     my $mail_replied         = '#AAAA88';
                   4849:     my $mail_replied_hover   = '#888855';
                   4850:     my $mail_other           = '#99BBBB';
                   4851:     my $mail_other_hover     = '#669999';
1.391     albertel 4852:     my $table_header         = '#DDDDDD';
1.489     raeburn  4853:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   4854:     my $lg_border_color      = '#C8C8C8';
1.952     onken    4855:     my $button_hover         = '#BF2317';
1.392     albertel 4856: 
1.608     albertel 4857:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   4858:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   4859:                                              : '0 3px 0 4px';
1.448     albertel 4860: 
1.523     albertel 4861: 
1.343     albertel 4862:     return <<END;
1.947     droeschl 4863: 
                   4864: /* needed for iframe to allow 100% height in FF */
                   4865: body, html { 
                   4866:     margin: 0;
                   4867:     padding: 0 0.5%;
                   4868:     height: 99%; /* to avoid scrollbars */
                   4869: }
                   4870: 
1.795     www      4871: body {
1.911     bisitz   4872:   font-family: $sans;
                   4873:   line-height:130%;
                   4874:   font-size:0.83em;
                   4875:   color:$font;
1.795     www      4876: }
                   4877: 
1.959     onken    4878: a:focus,
                   4879: a:focus img {
1.795     www      4880:   color: red;
1.911     bisitz   4881:   background: yellow;
1.795     www      4882: }
1.698     harmsja  4883: 
1.911     bisitz   4884: form, .inline {
                   4885:   display: inline;
1.795     www      4886: }
1.721     harmsja  4887: 
1.795     www      4888: .LC_right {
1.911     bisitz   4889:   text-align:right;
1.795     www      4890: }
                   4891: 
                   4892: .LC_middle {
1.911     bisitz   4893:   vertical-align:middle;
1.795     www      4894: }
1.721     harmsja  4895: 
1.911     bisitz   4896: .LC_400Box {
                   4897:   width:400px;
                   4898: }
1.721     harmsja  4899: 
1.947     droeschl 4900: .LC_iframecontainer {
                   4901:     width: 98%;
                   4902:     margin: 0;
                   4903:     position: fixed;
                   4904:     top: 8.5em;
                   4905:     bottom: 0;
                   4906: }
                   4907: 
                   4908: .LC_iframecontainer iframe{
                   4909:     border: none;
                   4910:     width: 100%;
                   4911:     height: 100%;
                   4912: }
                   4913: 
1.778     bisitz   4914: .LC_filename {
                   4915:   font-family: $mono;
                   4916:   white-space:pre;
1.921     bisitz   4917:   font-size: 120%;
1.778     bisitz   4918: }
                   4919: 
                   4920: .LC_fileicon {
                   4921:   border: none;
                   4922:   height: 1.3em;
                   4923:   vertical-align: text-bottom;
                   4924:   margin-right: 0.3em;
                   4925:   text-decoration:none;
                   4926: }
                   4927: 
1.350     albertel 4928: .LC_error {
                   4929:   color: red;
                   4930:   font-size: larger;
                   4931: }
1.795     www      4932: 
1.457     albertel 4933: .LC_warning,
                   4934: .LC_diff_removed {
1.733     bisitz   4935:   color: red;
1.394     albertel 4936: }
1.532     albertel 4937: 
                   4938: .LC_info,
1.457     albertel 4939: .LC_success,
                   4940: .LC_diff_added {
1.350     albertel 4941:   color: green;
                   4942: }
1.795     www      4943: 
1.802     bisitz   4944: div.LC_confirm_box {
                   4945:   background-color: #FAFAFA;
                   4946:   border: 1px solid $lg_border_color;
                   4947:   margin-right: 0;
                   4948:   padding: 5px;
                   4949: }
                   4950: 
                   4951: div.LC_confirm_box .LC_error img,
                   4952: div.LC_confirm_box .LC_success img {
                   4953:   vertical-align: middle;
                   4954: }
                   4955: 
1.440     albertel 4956: .LC_icon {
1.771     droeschl 4957:   border: none;
1.790     droeschl 4958:   vertical-align: middle;
1.771     droeschl 4959: }
                   4960: 
1.543     albertel 4961: .LC_docs_spacer {
                   4962:   width: 25px;
                   4963:   height: 1px;
1.771     droeschl 4964:   border: none;
1.543     albertel 4965: }
1.346     albertel 4966: 
1.532     albertel 4967: .LC_internal_info {
1.735     bisitz   4968:   color: #999999;
1.532     albertel 4969: }
                   4970: 
1.794     www      4971: .LC_discussion {
1.911     bisitz   4972:   background: $tabbg;
                   4973:   border: 1px solid black;
                   4974:   margin: 2px;
1.794     www      4975: }
                   4976: 
                   4977: .LC_disc_action_links_bar {
1.911     bisitz   4978:   background: $tabbg;
                   4979:   border: none;
                   4980:   margin: 4px;
1.794     www      4981: }
                   4982: 
                   4983: .LC_disc_action_left {
1.911     bisitz   4984:   text-align: left;
1.794     www      4985: }
                   4986: 
                   4987: .LC_disc_action_right {
1.911     bisitz   4988:   text-align: right;
1.794     www      4989: }
                   4990: 
                   4991: .LC_disc_new_item {
1.911     bisitz   4992:   background: white;
                   4993:   border: 2px solid red;
                   4994:   margin: 2px;
1.794     www      4995: }
                   4996: 
                   4997: .LC_disc_old_item {
1.911     bisitz   4998:   background: white;
                   4999:   border: 1px solid black;
                   5000:   margin: 2px;
1.794     www      5001: }
                   5002: 
1.458     albertel 5003: table.LC_pastsubmission {
                   5004:   border: 1px solid black;
                   5005:   margin: 2px;
                   5006: }
                   5007: 
1.924     bisitz   5008: table#LC_menubuttons {
1.345     albertel 5009:   width: 100%;
                   5010:   background: $pgbg;
1.392     albertel 5011:   border: 2px;
1.402     albertel 5012:   border-collapse: separate;
1.803     bisitz   5013:   padding: 0;
1.345     albertel 5014: }
1.392     albertel 5015: 
1.801     tempelho 5016: table#LC_title_bar a {
                   5017:   color: $fontmenu;
                   5018: }
1.836     bisitz   5019: 
1.807     droeschl 5020: table#LC_title_bar {
1.819     tempelho 5021:   clear: both;
1.836     bisitz   5022:   display: none;
1.807     droeschl 5023: }
                   5024: 
1.795     www      5025: table#LC_title_bar,
1.933     droeschl 5026: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5027: table#LC_title_bar.LC_with_remote {
1.359     albertel 5028:   width: 100%;
1.392     albertel 5029:   border-color: $pgbg;
                   5030:   border-style: solid;
                   5031:   border-width: $border;
1.379     albertel 5032:   background: $pgbg;
1.801     tempelho 5033:   color: $fontmenu;
1.392     albertel 5034:   border-collapse: collapse;
1.803     bisitz   5035:   padding: 0;
1.819     tempelho 5036:   margin: 0;
1.359     albertel 5037: }
1.795     www      5038: 
1.933     droeschl 5039: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5040:     margin: 0;
                   5041:     padding: 0;
1.933     droeschl 5042:     position: relative;
                   5043:     list-style: none;
1.913     droeschl 5044: }
1.933     droeschl 5045: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5046:     display: inline;
                   5047: }
1.933     droeschl 5048: 
                   5049: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5050:     padding: 0;
1.933     droeschl 5051:     margin: 0;
                   5052:     float: left;
1.913     droeschl 5053: }
1.933     droeschl 5054: .LC_breadcrumb_tools_tools {
                   5055:     padding: 0;
                   5056:     margin: 0;
1.913     droeschl 5057:     float: right;
                   5058: }
                   5059: 
1.359     albertel 5060: table#LC_title_bar td {
                   5061:   background: $tabbg;
                   5062: }
1.795     www      5063: 
1.911     bisitz   5064: table#LC_menubuttons img {
1.803     bisitz   5065:   border: none;
1.346     albertel 5066: }
1.795     www      5067: 
1.842     droeschl 5068: .LC_breadcrumbs_component {
1.911     bisitz   5069:   float: right;
                   5070:   margin: 0 1em;
1.357     albertel 5071: }
1.842     droeschl 5072: .LC_breadcrumbs_component img {
1.911     bisitz   5073:   vertical-align: middle;
1.777     tempelho 5074: }
1.795     www      5075: 
1.383     albertel 5076: td.LC_table_cell_checkbox {
                   5077:   text-align: center;
                   5078: }
1.795     www      5079: 
                   5080: .LC_fontsize_small {
1.911     bisitz   5081:   font-size: 70%;
1.705     tempelho 5082: }
                   5083: 
1.844     bisitz   5084: #LC_breadcrumbs {
1.911     bisitz   5085:   clear:both;
                   5086:   background: $sidebg;
                   5087:   border-bottom: 1px solid $lg_border_color;
                   5088:   line-height: 2.5em;
1.933     droeschl 5089:   overflow: hidden;
1.911     bisitz   5090:   margin: 0;
                   5091:   padding: 0;
1.819     tempelho 5092: }
1.862     bisitz   5093: 
1.993     raeburn  5094: .LC_head_subbox {
1.911     bisitz   5095:   clear:both;
                   5096:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5097:   border: 1px solid $sidebg;
                   5098:   margin: 0 0 10px 0;      
1.966     bisitz   5099:   padding: 3px;
1.822     bisitz   5100: }
                   5101: 
1.795     www      5102: .LC_fontsize_medium {
1.911     bisitz   5103:   font-size: 85%;
1.705     tempelho 5104: }
                   5105: 
1.795     www      5106: .LC_fontsize_large {
1.911     bisitz   5107:   font-size: 120%;
1.705     tempelho 5108: }
                   5109: 
1.346     albertel 5110: .LC_menubuttons_inline_text {
                   5111:   color: $font;
1.698     harmsja  5112:   font-size: 90%;
1.701     harmsja  5113:   padding-left:3px;
1.346     albertel 5114: }
                   5115: 
1.934     droeschl 5116: .LC_menubuttons_inline_text img{
                   5117:   vertical-align: middle;
                   5118: }
                   5119: 
1.951     onken    5120: li.LC_menubuttons_inline_text img,a {
                   5121:   cursor:pointer;
                   5122: }
                   5123: 
1.526     www      5124: .LC_menubuttons_link {
                   5125:   text-decoration: none;
                   5126: }
1.795     www      5127: 
1.522     albertel 5128: .LC_menubuttons_category {
1.521     www      5129:   color: $font;
1.526     www      5130:   background: $pgbg;
1.521     www      5131:   font-size: larger;
                   5132:   font-weight: bold;
                   5133: }
                   5134: 
1.346     albertel 5135: td.LC_menubuttons_text {
1.911     bisitz   5136:   color: $font;
1.346     albertel 5137: }
1.706     harmsja  5138: 
1.346     albertel 5139: .LC_current_location {
                   5140:   background: $tabbg;
                   5141: }
1.795     www      5142: 
1.938     bisitz   5143: table.LC_data_table {
1.347     albertel 5144:   border: 1px solid #000000;
1.402     albertel 5145:   border-collapse: separate;
1.426     albertel 5146:   border-spacing: 1px;
1.610     albertel 5147:   background: $pgbg;
1.347     albertel 5148: }
1.795     www      5149: 
1.422     albertel 5150: .LC_data_table_dense {
                   5151:   font-size: small;
                   5152: }
1.795     www      5153: 
1.507     raeburn  5154: table.LC_nested_outer {
                   5155:   border: 1px solid #000000;
1.589     raeburn  5156:   border-collapse: collapse;
1.803     bisitz   5157:   border-spacing: 0;
1.507     raeburn  5158:   width: 100%;
                   5159: }
1.795     www      5160: 
1.879     raeburn  5161: table.LC_innerpickbox,
1.507     raeburn  5162: table.LC_nested {
1.803     bisitz   5163:   border: none;
1.589     raeburn  5164:   border-collapse: collapse;
1.803     bisitz   5165:   border-spacing: 0;
1.507     raeburn  5166:   width: 100%;
                   5167: }
1.795     www      5168: 
1.930     faziophi 5169: .ui-accordion,
                   5170: .ui-accordion table.LC_data_table,
                   5171: .ui-accordion table.LC_nested_outer{
                   5172:   border: 0px;
                   5173:   border-spacing: 0px;
                   5174:   margin: 3px;
                   5175: }
                   5176: 
1.911     bisitz   5177: table.LC_data_table tr th,
                   5178: table.LC_calendar tr th,
1.879     raeburn  5179: table.LC_prior_tries tr th,
                   5180: table.LC_innerpickbox tr th {
1.349     albertel 5181:   font-weight: bold;
                   5182:   background-color: $data_table_head;
1.801     tempelho 5183:   color:$fontmenu;
1.701     harmsja  5184:   font-size:90%;
1.347     albertel 5185: }
1.795     www      5186: 
1.879     raeburn  5187: table.LC_innerpickbox tr th,
                   5188: table.LC_innerpickbox tr td {
                   5189:   vertical-align: top;
                   5190: }
                   5191: 
1.711     raeburn  5192: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5193:   background-color: #CCCCCC;
1.711     raeburn  5194:   font-weight: bold;
                   5195:   text-align: left;
                   5196: }
1.795     www      5197: 
1.912     bisitz   5198: table.LC_data_table tr.LC_odd_row > td {
                   5199:   background-color: $data_table_light;
                   5200:   padding: 2px;
                   5201:   vertical-align: top;
                   5202: }
                   5203: 
1.809     bisitz   5204: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5205:   background-color: $data_table_light;
1.912     bisitz   5206:   vertical-align: top;
                   5207: }
                   5208: 
                   5209: table.LC_data_table tr.LC_even_row > td {
                   5210:   background-color: $data_table_dark;
1.425     albertel 5211:   padding: 2px;
1.900     bisitz   5212:   vertical-align: top;
1.347     albertel 5213: }
1.795     www      5214: 
1.809     bisitz   5215: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5216:   background-color: $data_table_dark;
1.900     bisitz   5217:   vertical-align: top;
1.347     albertel 5218: }
1.795     www      5219: 
1.425     albertel 5220: table.LC_data_table tr.LC_data_table_highlight td {
                   5221:   background-color: $data_table_darker;
                   5222: }
1.795     www      5223: 
1.639     raeburn  5224: table.LC_data_table tr td.LC_leftcol_header {
                   5225:   background-color: $data_table_head;
                   5226:   font-weight: bold;
                   5227: }
1.795     www      5228: 
1.451     albertel 5229: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5230: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5231:   font-weight: bold;
                   5232:   font-style: italic;
                   5233:   text-align: center;
                   5234:   padding: 8px;
1.347     albertel 5235: }
1.795     www      5236: 
1.940     bisitz   5237: table.LC_data_table tr.LC_empty_row td {
                   5238:   background-color: $sidebg;
                   5239: }
                   5240: 
                   5241: table.LC_nested tr.LC_empty_row td {
                   5242:   background-color: #FFFFFF;
                   5243: }
                   5244: 
1.890     droeschl 5245: table.LC_caption {
                   5246: }
                   5247: 
1.507     raeburn  5248: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5249:   padding: 4ex
                   5250: }
1.795     www      5251: 
1.507     raeburn  5252: table.LC_nested_outer tr th {
                   5253:   font-weight: bold;
1.801     tempelho 5254:   color:$fontmenu;
1.507     raeburn  5255:   background-color: $data_table_head;
1.701     harmsja  5256:   font-size: small;
1.507     raeburn  5257:   border-bottom: 1px solid #000000;
                   5258: }
1.795     www      5259: 
1.507     raeburn  5260: table.LC_nested_outer tr td.LC_subheader {
                   5261:   background-color: $data_table_head;
                   5262:   font-weight: bold;
                   5263:   font-size: small;
                   5264:   border-bottom: 1px solid #000000;
                   5265:   text-align: right;
1.451     albertel 5266: }
1.795     www      5267: 
1.507     raeburn  5268: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5269:   background-color: #CCCCCC;
1.451     albertel 5270:   font-weight: bold;
                   5271:   font-size: small;
1.507     raeburn  5272:   text-align: center;
                   5273: }
1.795     www      5274: 
1.589     raeburn  5275: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5276: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5277:   text-align: left;
1.451     albertel 5278: }
1.795     www      5279: 
1.507     raeburn  5280: table.LC_nested td {
1.735     bisitz   5281:   background-color: #FFFFFF;
1.451     albertel 5282:   font-size: small;
1.507     raeburn  5283: }
1.795     www      5284: 
1.507     raeburn  5285: table.LC_nested_outer tr th.LC_right_item,
                   5286: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5287: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5288: table.LC_nested tr td.LC_right_item {
1.451     albertel 5289:   text-align: right;
                   5290: }
                   5291: 
1.930     faziophi 5292: .ui-accordion table.LC_nested tr.LC_odd_row td.LC_left_item,
                   5293: .ui-accordion table.LC_nested tr.LC_even_row td.LC_left_item {
                   5294:   text-align: right;
                   5295:   width: 40%;
                   5296:   padding-right:10px;
                   5297:   vertical-align: top;
                   5298:   padding: 5px;
                   5299: }
                   5300: 
                   5301: .ui-accordion table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5302: .ui-accordion table.LC_nested tr.LC_even_row td.LC_right_item {
                   5303:   text-align: left;
                   5304:   width: 60%;
                   5305:   padding: 2px 4px;
                   5306: }
                   5307: 
1.507     raeburn  5308: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5309:   background-color: #EEEEEE;
1.451     albertel 5310: }
                   5311: 
1.473     raeburn  5312: table.LC_createuser {
                   5313: }
                   5314: 
                   5315: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5316:   font-size: small;
1.473     raeburn  5317: }
                   5318: 
                   5319: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5320:   background-color: #CCCCCC;
1.473     raeburn  5321:   font-weight: bold;
                   5322:   text-align: center;
                   5323: }
                   5324: 
1.349     albertel 5325: table.LC_calendar {
                   5326:   border: 1px solid #000000;
                   5327:   border-collapse: collapse;
1.917     raeburn  5328:   width: 98%;
1.349     albertel 5329: }
1.795     www      5330: 
1.349     albertel 5331: table.LC_calendar_pickdate {
                   5332:   font-size: xx-small;
                   5333: }
1.795     www      5334: 
1.349     albertel 5335: table.LC_calendar tr td {
                   5336:   border: 1px solid #000000;
                   5337:   vertical-align: top;
1.917     raeburn  5338:   width: 14%;
1.349     albertel 5339: }
1.795     www      5340: 
1.349     albertel 5341: table.LC_calendar tr td.LC_calendar_day_empty {
                   5342:   background-color: $data_table_dark;
                   5343: }
1.795     www      5344: 
1.779     bisitz   5345: table.LC_calendar tr td.LC_calendar_day_current {
                   5346:   background-color: $data_table_highlight;
1.777     tempelho 5347: }
1.795     www      5348: 
1.938     bisitz   5349: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5350:   background-color: $mail_new;
                   5351: }
1.795     www      5352: 
1.938     bisitz   5353: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5354:   background-color: $mail_new_hover;
                   5355: }
1.795     www      5356: 
1.938     bisitz   5357: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5358:   background-color: $mail_read;
                   5359: }
1.795     www      5360: 
1.938     bisitz   5361: /*
                   5362: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5363:   background-color: $mail_read_hover;
                   5364: }
1.938     bisitz   5365: */
1.795     www      5366: 
1.938     bisitz   5367: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5368:   background-color: $mail_replied;
                   5369: }
1.795     www      5370: 
1.938     bisitz   5371: /*
                   5372: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5373:   background-color: $mail_replied_hover;
                   5374: }
1.938     bisitz   5375: */
1.795     www      5376: 
1.938     bisitz   5377: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5378:   background-color: $mail_other;
                   5379: }
1.795     www      5380: 
1.938     bisitz   5381: /*
                   5382: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5383:   background-color: $mail_other_hover;
                   5384: }
1.938     bisitz   5385: */
1.494     raeburn  5386: 
1.777     tempelho 5387: table.LC_data_table tr > td.LC_browser_file,
                   5388: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5389:   background: #AAEE77;
1.389     albertel 5390: }
1.795     www      5391: 
1.777     tempelho 5392: table.LC_data_table tr > td.LC_browser_file_locked,
                   5393: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5394:   background: #FFAA99;
1.387     albertel 5395: }
1.795     www      5396: 
1.777     tempelho 5397: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5398:   background: #888888;
1.779     bisitz   5399: }
1.795     www      5400: 
1.777     tempelho 5401: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5402: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5403:   background: #F8F866;
1.777     tempelho 5404: }
1.795     www      5405: 
1.696     bisitz   5406: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5407:   background: #E0E8FF;
1.387     albertel 5408: }
1.696     bisitz   5409: 
1.707     bisitz   5410: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5411:   /* background: #77FF77; */
1.707     bisitz   5412: }
1.795     www      5413: 
1.707     bisitz   5414: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5415:   border-right: 8px solid #FFFF77;
1.707     bisitz   5416: }
1.795     www      5417: 
1.707     bisitz   5418: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5419:   border-right: 8px solid #FFAA77;
1.707     bisitz   5420: }
1.795     www      5421: 
1.707     bisitz   5422: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5423:   border-right: 8px solid #FF7777;
1.707     bisitz   5424: }
1.795     www      5425: 
1.707     bisitz   5426: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5427:   border-right: 8px solid #AAFF77;
1.707     bisitz   5428: }
1.795     www      5429: 
1.707     bisitz   5430: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5431:   border-right: 8px solid #11CC55;
1.707     bisitz   5432: }
                   5433: 
1.388     albertel 5434: span.LC_current_location {
1.701     harmsja  5435:   font-size:larger;
1.388     albertel 5436:   background: $pgbg;
                   5437: }
1.387     albertel 5438: 
1.395     albertel 5439: span.LC_parm_menu_item {
                   5440:   font-size: larger;
                   5441: }
1.795     www      5442: 
1.395     albertel 5443: span.LC_parm_scope_all {
                   5444:   color: red;
                   5445: }
1.795     www      5446: 
1.395     albertel 5447: span.LC_parm_scope_folder {
                   5448:   color: green;
                   5449: }
1.795     www      5450: 
1.395     albertel 5451: span.LC_parm_scope_resource {
                   5452:   color: orange;
                   5453: }
1.795     www      5454: 
1.395     albertel 5455: span.LC_parm_part {
                   5456:   color: blue;
                   5457: }
1.795     www      5458: 
1.911     bisitz   5459: span.LC_parm_folder,
                   5460: span.LC_parm_symb {
1.395     albertel 5461:   font-size: x-small;
                   5462:   font-family: $mono;
                   5463:   color: #AAAAAA;
                   5464: }
                   5465: 
1.977     bisitz   5466: ul.LC_parm_parmlist li {
                   5467:   display: inline-block;
                   5468:   padding: 0.3em 0.8em;
                   5469:   vertical-align: top;
                   5470:   width: 150px;
                   5471:   border-top:1px solid $lg_border_color;
                   5472: }
                   5473: 
1.795     www      5474: td.LC_parm_overview_level_menu,
                   5475: td.LC_parm_overview_map_menu,
                   5476: td.LC_parm_overview_parm_selectors,
                   5477: td.LC_parm_overview_restrictions  {
1.396     albertel 5478:   border: 1px solid black;
                   5479:   border-collapse: collapse;
                   5480: }
1.795     www      5481: 
1.396     albertel 5482: table.LC_parm_overview_restrictions td {
                   5483:   border-width: 1px 4px 1px 4px;
                   5484:   border-style: solid;
                   5485:   border-color: $pgbg;
                   5486:   text-align: center;
                   5487: }
1.795     www      5488: 
1.396     albertel 5489: table.LC_parm_overview_restrictions th {
                   5490:   background: $tabbg;
                   5491:   border-width: 1px 4px 1px 4px;
                   5492:   border-style: solid;
                   5493:   border-color: $pgbg;
                   5494: }
1.795     www      5495: 
1.398     albertel 5496: table#LC_helpmenu {
1.803     bisitz   5497:   border: none;
1.398     albertel 5498:   height: 55px;
1.803     bisitz   5499:   border-spacing: 0;
1.398     albertel 5500: }
                   5501: 
                   5502: table#LC_helpmenu fieldset legend {
                   5503:   font-size: larger;
                   5504: }
1.795     www      5505: 
1.397     albertel 5506: table#LC_helpmenu_links {
                   5507:   width: 100%;
                   5508:   border: 1px solid black;
                   5509:   background: $pgbg;
1.803     bisitz   5510:   padding: 0;
1.397     albertel 5511:   border-spacing: 1px;
                   5512: }
1.795     www      5513: 
1.397     albertel 5514: table#LC_helpmenu_links tr td {
                   5515:   padding: 1px;
                   5516:   background: $tabbg;
1.399     albertel 5517:   text-align: center;
                   5518:   font-weight: bold;
1.397     albertel 5519: }
1.396     albertel 5520: 
1.795     www      5521: table#LC_helpmenu_links a:link,
                   5522: table#LC_helpmenu_links a:visited,
1.397     albertel 5523: table#LC_helpmenu_links a:active {
                   5524:   text-decoration: none;
                   5525:   color: $font;
                   5526: }
1.795     www      5527: 
1.397     albertel 5528: table#LC_helpmenu_links a:hover {
                   5529:   text-decoration: underline;
                   5530:   color: $vlink;
                   5531: }
1.396     albertel 5532: 
1.417     albertel 5533: .LC_chrt_popup_exists {
                   5534:   border: 1px solid #339933;
                   5535:   margin: -1px;
                   5536: }
1.795     www      5537: 
1.417     albertel 5538: .LC_chrt_popup_up {
                   5539:   border: 1px solid yellow;
                   5540:   margin: -1px;
                   5541: }
1.795     www      5542: 
1.417     albertel 5543: .LC_chrt_popup {
                   5544:   border: 1px solid #8888FF;
                   5545:   background: #CCCCFF;
                   5546: }
1.795     www      5547: 
1.421     albertel 5548: table.LC_pick_box {
                   5549:   border-collapse: separate;
                   5550:   background: white;
                   5551:   border: 1px solid black;
                   5552:   border-spacing: 1px;
                   5553: }
1.795     www      5554: 
1.421     albertel 5555: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   5556:   background: $sidebg;
1.421     albertel 5557:   font-weight: bold;
1.900     bisitz   5558:   text-align: left;
1.740     bisitz   5559:   vertical-align: top;
1.421     albertel 5560:   width: 184px;
                   5561:   padding: 8px;
                   5562: }
1.795     www      5563: 
1.579     raeburn  5564: table.LC_pick_box td.LC_pick_box_value {
                   5565:   text-align: left;
                   5566:   padding: 8px;
                   5567: }
1.795     www      5568: 
1.579     raeburn  5569: table.LC_pick_box td.LC_pick_box_select {
                   5570:   text-align: left;
                   5571:   padding: 8px;
                   5572: }
1.795     www      5573: 
1.424     albertel 5574: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   5575:   padding: 0;
1.421     albertel 5576:   height: 1px;
                   5577:   background: black;
                   5578: }
1.795     www      5579: 
1.421     albertel 5580: table.LC_pick_box td.LC_pick_box_submit {
                   5581:   text-align: right;
                   5582: }
1.795     www      5583: 
1.579     raeburn  5584: table.LC_pick_box td.LC_evenrow_value {
                   5585:   text-align: left;
                   5586:   padding: 8px;
                   5587:   background-color: $data_table_light;
                   5588: }
1.795     www      5589: 
1.579     raeburn  5590: table.LC_pick_box td.LC_oddrow_value {
                   5591:   text-align: left;
                   5592:   padding: 8px;
                   5593:   background-color: $data_table_light;
                   5594: }
1.795     www      5595: 
1.579     raeburn  5596: span.LC_helpform_receipt_cat {
                   5597:   font-weight: bold;
                   5598: }
1.795     www      5599: 
1.424     albertel 5600: table.LC_group_priv_box {
                   5601:   background: white;
                   5602:   border: 1px solid black;
                   5603:   border-spacing: 1px;
                   5604: }
1.795     www      5605: 
1.424     albertel 5606: table.LC_group_priv_box td.LC_pick_box_title {
                   5607:   background: $tabbg;
                   5608:   font-weight: bold;
                   5609:   text-align: right;
                   5610:   width: 184px;
                   5611: }
1.795     www      5612: 
1.424     albertel 5613: table.LC_group_priv_box td.LC_groups_fixed {
                   5614:   background: $data_table_light;
                   5615:   text-align: center;
                   5616: }
1.795     www      5617: 
1.424     albertel 5618: table.LC_group_priv_box td.LC_groups_optional {
                   5619:   background: $data_table_dark;
                   5620:   text-align: center;
                   5621: }
1.795     www      5622: 
1.424     albertel 5623: table.LC_group_priv_box td.LC_groups_functionality {
                   5624:   background: $data_table_darker;
                   5625:   text-align: center;
                   5626:   font-weight: bold;
                   5627: }
1.795     www      5628: 
1.424     albertel 5629: table.LC_group_priv td {
                   5630:   text-align: left;
1.803     bisitz   5631:   padding: 0;
1.424     albertel 5632: }
                   5633: 
                   5634: .LC_navbuttons {
                   5635:   margin: 2ex 0ex 2ex 0ex;
                   5636: }
1.795     www      5637: 
1.423     albertel 5638: .LC_topic_bar {
                   5639:   font-weight: bold;
                   5640:   background: $tabbg;
1.918     wenzelju 5641:   margin: 1em 0em 1em 2em;
1.805     bisitz   5642:   padding: 3px;
1.918     wenzelju 5643:   font-size: 1.2em;
1.423     albertel 5644: }
1.795     www      5645: 
1.423     albertel 5646: .LC_topic_bar span {
1.918     wenzelju 5647:   left: 0.5em;
                   5648:   position: absolute;
1.423     albertel 5649:   vertical-align: middle;
1.918     wenzelju 5650:   font-size: 1.2em;
1.423     albertel 5651: }
1.795     www      5652: 
1.423     albertel 5653: table.LC_course_group_status {
                   5654:   margin: 20px;
                   5655: }
1.795     www      5656: 
1.423     albertel 5657: table.LC_status_selector td {
                   5658:   vertical-align: top;
                   5659:   text-align: center;
1.424     albertel 5660:   padding: 4px;
                   5661: }
1.795     www      5662: 
1.599     albertel 5663: div.LC_feedback_link {
1.616     albertel 5664:   clear: both;
1.829     kalberla 5665:   background: $sidebg;
1.779     bisitz   5666:   width: 100%;
1.829     kalberla 5667:   padding-bottom: 10px;
                   5668:   border: 1px $tabbg solid;
1.833     kalberla 5669:   height: 22px;
                   5670:   line-height: 22px;
                   5671:   padding-top: 5px;
                   5672: }
                   5673: 
                   5674: div.LC_feedback_link img {
                   5675:   height: 22px;
1.867     kalberla 5676:   vertical-align:middle;
1.829     kalberla 5677: }
                   5678: 
1.911     bisitz   5679: div.LC_feedback_link a {
1.829     kalberla 5680:   text-decoration: none;
1.489     raeburn  5681: }
1.795     www      5682: 
1.867     kalberla 5683: div.LC_comblock {
1.911     bisitz   5684:   display:inline;
1.867     kalberla 5685:   color:$font;
                   5686:   font-size:90%;
                   5687: }
                   5688: 
                   5689: div.LC_feedback_link div.LC_comblock {
                   5690:   padding-left:5px;
                   5691: }
                   5692: 
                   5693: div.LC_feedback_link div.LC_comblock a {
                   5694:   color:$font;
                   5695: }
                   5696: 
1.489     raeburn  5697: span.LC_feedback_link {
1.858     bisitz   5698:   /* background: $feedback_link_bg; */
1.599     albertel 5699:   font-size: larger;
                   5700: }
1.795     www      5701: 
1.599     albertel 5702: span.LC_message_link {
1.858     bisitz   5703:   /* background: $feedback_link_bg; */
1.599     albertel 5704:   font-size: larger;
                   5705:   position: absolute;
                   5706:   right: 1em;
1.489     raeburn  5707: }
1.421     albertel 5708: 
1.515     albertel 5709: table.LC_prior_tries {
1.524     albertel 5710:   border: 1px solid #000000;
                   5711:   border-collapse: separate;
                   5712:   border-spacing: 1px;
1.515     albertel 5713: }
1.523     albertel 5714: 
1.515     albertel 5715: table.LC_prior_tries td {
1.524     albertel 5716:   padding: 2px;
1.515     albertel 5717: }
1.523     albertel 5718: 
                   5719: .LC_answer_correct {
1.795     www      5720:   background: lightgreen;
                   5721:   color: darkgreen;
                   5722:   padding: 6px;
1.523     albertel 5723: }
1.795     www      5724: 
1.523     albertel 5725: .LC_answer_charged_try {
1.797     www      5726:   background: #FFAAAA;
1.795     www      5727:   color: darkred;
                   5728:   padding: 6px;
1.523     albertel 5729: }
1.795     www      5730: 
1.779     bisitz   5731: .LC_answer_not_charged_try,
1.523     albertel 5732: .LC_answer_no_grade,
                   5733: .LC_answer_late {
1.795     www      5734:   background: lightyellow;
1.523     albertel 5735:   color: black;
1.795     www      5736:   padding: 6px;
1.523     albertel 5737: }
1.795     www      5738: 
1.523     albertel 5739: .LC_answer_previous {
1.795     www      5740:   background: lightblue;
                   5741:   color: darkblue;
                   5742:   padding: 6px;
1.523     albertel 5743: }
1.795     www      5744: 
1.779     bisitz   5745: .LC_answer_no_message {
1.777     tempelho 5746:   background: #FFFFFF;
                   5747:   color: black;
1.795     www      5748:   padding: 6px;
1.779     bisitz   5749: }
1.795     www      5750: 
1.779     bisitz   5751: .LC_answer_unknown {
                   5752:   background: orange;
                   5753:   color: black;
1.795     www      5754:   padding: 6px;
1.777     tempelho 5755: }
1.795     www      5756: 
1.529     albertel 5757: span.LC_prior_numerical,
                   5758: span.LC_prior_string,
                   5759: span.LC_prior_custom,
                   5760: span.LC_prior_reaction,
                   5761: span.LC_prior_math {
1.925     bisitz   5762:   font-family: $mono;
1.523     albertel 5763:   white-space: pre;
                   5764: }
                   5765: 
1.525     albertel 5766: span.LC_prior_string {
1.925     bisitz   5767:   font-family: $mono;
1.525     albertel 5768:   white-space: pre;
                   5769: }
                   5770: 
1.523     albertel 5771: table.LC_prior_option {
                   5772:   width: 100%;
                   5773:   border-collapse: collapse;
                   5774: }
1.795     www      5775: 
1.911     bisitz   5776: table.LC_prior_rank,
1.795     www      5777: table.LC_prior_match {
1.528     albertel 5778:   border-collapse: collapse;
                   5779: }
1.795     www      5780: 
1.528     albertel 5781: table.LC_prior_option tr td,
                   5782: table.LC_prior_rank tr td,
                   5783: table.LC_prior_match tr td {
1.524     albertel 5784:   border: 1px solid #000000;
1.515     albertel 5785: }
                   5786: 
1.855     bisitz   5787: .LC_nobreak {
1.544     albertel 5788:   white-space: nowrap;
1.519     raeburn  5789: }
                   5790: 
1.576     raeburn  5791: span.LC_cusr_emph {
                   5792:   font-style: italic;
                   5793: }
                   5794: 
1.633     raeburn  5795: span.LC_cusr_subheading {
                   5796:   font-weight: normal;
                   5797:   font-size: 85%;
                   5798: }
                   5799: 
1.861     bisitz   5800: div.LC_docs_entry_move {
1.859     bisitz   5801:   border: 1px solid #BBBBBB;
1.545     albertel 5802:   background: #DDDDDD;
1.861     bisitz   5803:   width: 22px;
1.859     bisitz   5804:   padding: 1px;
                   5805:   margin: 0;
1.545     albertel 5806: }
                   5807: 
1.861     bisitz   5808: table.LC_data_table tr > td.LC_docs_entry_commands,
                   5809: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 5810:   background: #DDDDDD;
                   5811:   font-size: x-small;
                   5812: }
1.795     www      5813: 
1.861     bisitz   5814: .LC_docs_entry_parameter {
                   5815:   white-space: nowrap;
                   5816: }
                   5817: 
1.544     albertel 5818: .LC_docs_copy {
1.545     albertel 5819:   color: #000099;
1.544     albertel 5820: }
1.795     www      5821: 
1.544     albertel 5822: .LC_docs_cut {
1.545     albertel 5823:   color: #550044;
1.544     albertel 5824: }
1.795     www      5825: 
1.544     albertel 5826: .LC_docs_rename {
1.545     albertel 5827:   color: #009900;
1.544     albertel 5828: }
1.795     www      5829: 
1.544     albertel 5830: .LC_docs_remove {
1.545     albertel 5831:   color: #990000;
                   5832: }
                   5833: 
1.547     albertel 5834: .LC_docs_reinit_warn,
                   5835: .LC_docs_ext_edit {
                   5836:   font-size: x-small;
                   5837: }
                   5838: 
1.545     albertel 5839: table.LC_docs_adddocs td,
                   5840: table.LC_docs_adddocs th {
                   5841:   border: 1px solid #BBBBBB;
                   5842:   padding: 4px;
                   5843:   background: #DDDDDD;
1.543     albertel 5844: }
                   5845: 
1.584     albertel 5846: table.LC_sty_begin {
                   5847:   background: #BBFFBB;
                   5848: }
1.795     www      5849: 
1.584     albertel 5850: table.LC_sty_end {
                   5851:   background: #FFBBBB;
                   5852: }
                   5853: 
1.589     raeburn  5854: table.LC_double_column {
1.803     bisitz   5855:   border-width: 0;
1.589     raeburn  5856:   border-collapse: collapse;
                   5857:   width: 100%;
                   5858:   padding: 2px;
                   5859: }
                   5860: 
                   5861: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  5862:   top: 2px;
1.589     raeburn  5863:   left: 2px;
                   5864:   width: 47%;
                   5865:   vertical-align: top;
                   5866: }
                   5867: 
                   5868: table.LC_double_column tr td.LC_right_col {
                   5869:   top: 2px;
1.779     bisitz   5870:   right: 2px;
1.589     raeburn  5871:   width: 47%;
                   5872:   vertical-align: top;
                   5873: }
                   5874: 
1.591     raeburn  5875: div.LC_left_float {
                   5876:   float: left;
                   5877:   padding-right: 5%;
1.597     albertel 5878:   padding-bottom: 4px;
1.591     raeburn  5879: }
                   5880: 
                   5881: div.LC_clear_float_header {
1.597     albertel 5882:   padding-bottom: 2px;
1.591     raeburn  5883: }
                   5884: 
                   5885: div.LC_clear_float_footer {
1.597     albertel 5886:   padding-top: 10px;
1.591     raeburn  5887:   clear: both;
                   5888: }
                   5889: 
1.597     albertel 5890: div.LC_grade_show_user {
1.941     bisitz   5891: /*  border-left: 5px solid $sidebg; */
                   5892:   border-top: 5px solid #000000;
                   5893:   margin: 50px 0 0 0;
1.936     bisitz   5894:   padding: 15px 0 5px 10px;
1.597     albertel 5895: }
1.795     www      5896: 
1.936     bisitz   5897: div.LC_grade_show_user_odd_row {
1.941     bisitz   5898: /*  border-left: 5px solid #000000; */
                   5899: }
                   5900: 
                   5901: div.LC_grade_show_user div.LC_Box {
                   5902:   margin-right: 50px;
1.597     albertel 5903: }
                   5904: 
                   5905: div.LC_grade_submissions,
                   5906: div.LC_grade_message_center,
1.936     bisitz   5907: div.LC_grade_info_links {
1.597     albertel 5908:   margin: 5px;
                   5909:   width: 99%;
                   5910:   background: #FFFFFF;
                   5911: }
1.795     www      5912: 
1.597     albertel 5913: div.LC_grade_submissions_header,
1.936     bisitz   5914: div.LC_grade_message_center_header {
1.705     tempelho 5915:   font-weight: bold;
                   5916:   font-size: large;
1.597     albertel 5917: }
1.795     www      5918: 
1.597     albertel 5919: div.LC_grade_submissions_body,
1.936     bisitz   5920: div.LC_grade_message_center_body {
1.597     albertel 5921:   border: 1px solid black;
                   5922:   width: 99%;
                   5923:   background: #FFFFFF;
                   5924: }
1.795     www      5925: 
1.613     albertel 5926: table.LC_scantron_action {
                   5927:   width: 100%;
                   5928: }
1.795     www      5929: 
1.613     albertel 5930: table.LC_scantron_action tr th {
1.698     harmsja  5931:   font-weight:bold;
                   5932:   font-style:normal;
1.613     albertel 5933: }
1.795     www      5934: 
1.779     bisitz   5935: .LC_edit_problem_header,
1.614     albertel 5936: div.LC_edit_problem_footer {
1.705     tempelho 5937:   font-weight: normal;
                   5938:   font-size:  medium;
1.602     albertel 5939:   margin: 2px;
1.600     albertel 5940: }
1.795     www      5941: 
1.600     albertel 5942: div.LC_edit_problem_header,
1.602     albertel 5943: div.LC_edit_problem_header div,
1.614     albertel 5944: div.LC_edit_problem_footer,
                   5945: div.LC_edit_problem_footer div,
1.602     albertel 5946: div.LC_edit_problem_editxml_header,
                   5947: div.LC_edit_problem_editxml_header div {
1.600     albertel 5948:   margin-top: 5px;
                   5949: }
1.795     www      5950: 
1.600     albertel 5951: div.LC_edit_problem_header_title {
1.705     tempelho 5952:   font-weight: bold;
                   5953:   font-size: larger;
1.602     albertel 5954:   background: $tabbg;
                   5955:   padding: 3px;
                   5956: }
1.795     www      5957: 
1.602     albertel 5958: table.LC_edit_problem_header_title {
                   5959:   width: 100%;
1.600     albertel 5960:   background: $tabbg;
1.602     albertel 5961: }
                   5962: 
                   5963: div.LC_edit_problem_discards {
                   5964:   float: left;
                   5965:   padding-bottom: 5px;
                   5966: }
1.795     www      5967: 
1.602     albertel 5968: div.LC_edit_problem_saves {
                   5969:   float: right;
                   5970:   padding-bottom: 5px;
1.600     albertel 5971: }
1.795     www      5972: 
1.911     bisitz   5973: img.stift {
1.803     bisitz   5974:   border-width: 0;
                   5975:   vertical-align: middle;
1.677     riegler  5976: }
1.680     riegler  5977: 
1.923     bisitz   5978: table td.LC_mainmenu_col_fieldset {
1.680     riegler  5979:   vertical-align: top;
1.777     tempelho 5980: }
1.795     www      5981: 
1.716     raeburn  5982: div.LC_createcourse {
1.911     bisitz   5983:   margin: 10px 10px 10px 10px;
1.716     raeburn  5984: }
                   5985: 
1.917     raeburn  5986: .LC_dccid {
                   5987:   margin: 0.2em 0 0 0;
                   5988:   padding: 0;
                   5989:   font-size: 90%;
                   5990:   display:none;
                   5991: }
                   5992: 
1.698     harmsja  5993: a:hover,
1.897     wenzelju 5994: ol.LC_primary_menu a:hover,
1.721     harmsja  5995: ol#LC_MenuBreadcrumbs a:hover,
                   5996: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 5997: ul#LC_secondary_menu a:hover,
1.721     harmsja  5998: .LC_FormSectionClearButton input:hover
1.795     www      5999: ul.LC_TabContent   li:hover a {
1.952     onken    6000:   color:$button_hover;
1.911     bisitz   6001:   text-decoration:none;
1.693     droeschl 6002: }
                   6003: 
1.779     bisitz   6004: h1 {
1.911     bisitz   6005:   padding: 0;
                   6006:   line-height:130%;
1.693     droeschl 6007: }
1.698     harmsja  6008: 
1.911     bisitz   6009: h2,
                   6010: h3,
                   6011: h4,
                   6012: h5,
                   6013: h6 {
                   6014:   margin: 5px 0 5px 0;
                   6015:   padding: 0;
                   6016:   line-height:130%;
1.693     droeschl 6017: }
1.795     www      6018: 
                   6019: .LC_hcell {
1.911     bisitz   6020:   padding:3px 15px 3px 15px;
                   6021:   margin: 0;
                   6022:   background-color:$tabbg;
                   6023:   color:$fontmenu;
                   6024:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6025: }
1.795     www      6026: 
1.840     bisitz   6027: .LC_Box > .LC_hcell {
1.911     bisitz   6028:   margin: 0 -10px 10px -10px;
1.835     bisitz   6029: }
                   6030: 
1.721     harmsja  6031: .LC_noBorder {
1.911     bisitz   6032:   border: 0;
1.698     harmsja  6033: }
1.693     droeschl 6034: 
1.721     harmsja  6035: .LC_FormSectionClearButton input {
1.911     bisitz   6036:   background-color:transparent;
                   6037:   border: none;
                   6038:   cursor:pointer;
                   6039:   text-decoration:underline;
1.693     droeschl 6040: }
1.763     bisitz   6041: 
                   6042: .LC_help_open_topic {
1.911     bisitz   6043:   color: #FFFFFF;
                   6044:   background-color: #EEEEFF;
                   6045:   margin: 1px;
                   6046:   padding: 4px;
                   6047:   border: 1px solid #000033;
                   6048:   white-space: nowrap;
                   6049:   /* vertical-align: middle; */
1.759     neumanie 6050: }
1.693     droeschl 6051: 
1.911     bisitz   6052: dl,
                   6053: ul,
                   6054: div,
                   6055: fieldset {
                   6056:   margin: 10px 10px 10px 0;
                   6057:   /* overflow: hidden; */
1.693     droeschl 6058: }
1.795     www      6059: 
1.838     bisitz   6060: fieldset > legend {
1.911     bisitz   6061:   font-weight: bold;
                   6062:   padding: 0 5px 0 5px;
1.838     bisitz   6063: }
                   6064: 
1.813     bisitz   6065: #LC_nav_bar {
1.911     bisitz   6066:   float: left;
1.966     bisitz   6067:   margin: 0 0 2px 0;
1.807     droeschl 6068: }
                   6069: 
1.916     droeschl 6070: #LC_realm {
                   6071:   margin: 0.2em 0 0 0;
                   6072:   padding: 0;
                   6073:   font-weight: bold;
                   6074:   text-align: center;
                   6075: }
                   6076: 
1.911     bisitz   6077: #LC_nav_bar em {
                   6078:   font-weight: bold;
                   6079:   font-style: normal;
1.807     droeschl 6080: }
                   6081: 
1.897     wenzelju 6082: ol.LC_primary_menu {
1.911     bisitz   6083:   float: right;
1.934     droeschl 6084:   margin: 0;
1.807     droeschl 6085: }
                   6086: 
1.852     droeschl 6087: ol#LC_PathBreadcrumbs {
1.911     bisitz   6088:   margin: 0;
1.693     droeschl 6089: }
                   6090: 
1.897     wenzelju 6091: ol.LC_primary_menu li {
1.911     bisitz   6092:   display: inline;
                   6093:   padding: 5px 5px 0 10px;
                   6094:   vertical-align: top;
1.693     droeschl 6095: }
                   6096: 
1.897     wenzelju 6097: ol.LC_primary_menu li img {
1.911     bisitz   6098:   vertical-align: bottom;
1.934     droeschl 6099:   height: 1.1em;
1.693     droeschl 6100: }
                   6101: 
1.897     wenzelju 6102: ol.LC_primary_menu a {
1.911     bisitz   6103:   color: RGB(80, 80, 80);
                   6104:   text-decoration: none;
1.693     droeschl 6105: }
1.795     www      6106: 
1.949     droeschl 6107: ol.LC_primary_menu a.LC_new_message {
                   6108:   font-weight:bold;
                   6109:   color: darkred;
                   6110: }
                   6111: 
1.975     raeburn  6112: ol.LC_docs_parameters {
                   6113:   margin-left: 0;
                   6114:   padding: 0;
                   6115:   list-style: none;
                   6116: }
                   6117: 
                   6118: ol.LC_docs_parameters li {
                   6119:   margin: 0;
                   6120:   padding-right: 20px;
                   6121:   display: inline;
                   6122: }
                   6123: 
1.976     raeburn  6124: ol.LC_docs_parameters li:before {
                   6125:   content: "\\002022 \\0020";
                   6126: }
                   6127: 
                   6128: li.LC_docs_parameters_title {
                   6129:   font-weight: bold;
                   6130: }
                   6131: 
                   6132: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6133:   content: "";
                   6134: }
                   6135: 
1.897     wenzelju 6136: ul#LC_secondary_menu {
1.911     bisitz   6137:   clear: both;
                   6138:   color: $fontmenu;
                   6139:   background: $tabbg;
                   6140:   list-style: none;
                   6141:   padding: 0;
                   6142:   margin: 0;
                   6143:   width: 100%;
1.808     droeschl 6144: }
                   6145: 
1.897     wenzelju 6146: ul#LC_secondary_menu li {
1.911     bisitz   6147:   font-weight: bold;
                   6148:   line-height: 1.8em;
                   6149:   padding: 0 0.8em;
                   6150:   border-right: 1px solid black;
                   6151:   display: inline;
                   6152:   vertical-align: middle;
1.807     droeschl 6153: }
                   6154: 
1.847     tempelho 6155: ul.LC_TabContent {
1.911     bisitz   6156:   display:block;
                   6157:   background: $sidebg;
                   6158:   border-bottom: solid 1px $lg_border_color;
                   6159:   list-style:none;
                   6160:   margin: 0 -10px;
                   6161:   padding: 0;
1.693     droeschl 6162: }
                   6163: 
1.795     www      6164: ul.LC_TabContent li,
                   6165: ul.LC_TabContentBigger li {
1.911     bisitz   6166:   float:left;
1.741     harmsja  6167: }
1.795     www      6168: 
1.897     wenzelju 6169: ul#LC_secondary_menu li a {
1.911     bisitz   6170:   color: $fontmenu;
                   6171:   text-decoration: none;
1.693     droeschl 6172: }
1.795     www      6173: 
1.721     harmsja  6174: ul.LC_TabContent {
1.952     onken    6175:   min-height:20px;
1.721     harmsja  6176: }
1.795     www      6177: 
                   6178: ul.LC_TabContent li {
1.911     bisitz   6179:   vertical-align:middle;
1.959     onken    6180:   padding: 0 16px 0 10px;
1.911     bisitz   6181:   background-color:$tabbg;
                   6182:   border-bottom:solid 1px $lg_border_color;
1.952     onken    6183:   border-right: solid 1px $font;
1.721     harmsja  6184: }
1.795     www      6185: 
1.847     tempelho 6186: ul.LC_TabContent .right {
1.911     bisitz   6187:   float:right;
1.847     tempelho 6188: }
                   6189: 
1.911     bisitz   6190: ul.LC_TabContent li a,
                   6191: ul.LC_TabContent li {
                   6192:   color:rgb(47,47,47);
                   6193:   text-decoration:none;
                   6194:   font-size:95%;
                   6195:   font-weight:bold;
1.952     onken    6196:   min-height:20px;
                   6197: }
                   6198: 
1.959     onken    6199: ul.LC_TabContent li a:hover,
                   6200: ul.LC_TabContent li a:focus {
1.952     onken    6201:   color: $button_hover;
1.959     onken    6202:   background:none;
                   6203:   outline:none;
1.952     onken    6204: }
                   6205: 
                   6206: ul.LC_TabContent li:hover {
                   6207:   color: $button_hover;
                   6208:   cursor:pointer;
1.721     harmsja  6209: }
1.795     www      6210: 
1.911     bisitz   6211: ul.LC_TabContent li.active {
1.952     onken    6212:   color: $font;
1.911     bisitz   6213:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6214:   border-bottom:solid 1px #FFFFFF;
                   6215:   cursor: default;
1.744     ehlerst  6216: }
1.795     www      6217: 
1.959     onken    6218: ul.LC_TabContent li.active a {
                   6219:   color:$font;
                   6220:   background:#FFFFFF;
                   6221:   outline: none;
                   6222: }
1.870     tempelho 6223: #maincoursedoc {
1.911     bisitz   6224:   clear:both;
1.870     tempelho 6225: }
                   6226: 
                   6227: ul.LC_TabContentBigger {
1.911     bisitz   6228:   display:block;
                   6229:   list-style:none;
                   6230:   padding: 0;
1.870     tempelho 6231: }
                   6232: 
1.795     www      6233: ul.LC_TabContentBigger li {
1.911     bisitz   6234:   vertical-align:bottom;
                   6235:   height: 30px;
                   6236:   font-size:110%;
                   6237:   font-weight:bold;
                   6238:   color: #737373;
1.841     tempelho 6239: }
                   6240: 
1.957     onken    6241: ul.LC_TabContentBigger li.active {
                   6242:   position: relative;
                   6243:   top: 1px;
                   6244: }
                   6245: 
1.870     tempelho 6246: ul.LC_TabContentBigger li a {
1.911     bisitz   6247:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6248:   height: 30px;
                   6249:   line-height: 30px;
                   6250:   text-align: center;
                   6251:   display: block;
                   6252:   text-decoration: none;
1.958     onken    6253:   outline: none;  
1.741     harmsja  6254: }
1.795     www      6255: 
1.870     tempelho 6256: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6257:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6258:   color:$font;
1.744     ehlerst  6259: }
1.795     www      6260: 
1.870     tempelho 6261: ul.LC_TabContentBigger li b {
1.911     bisitz   6262:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6263:   display: block;
                   6264:   float: left;
                   6265:   padding: 0 30px;
1.957     onken    6266:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6267: }
                   6268: 
1.956     onken    6269: ul.LC_TabContentBigger li:hover b {
                   6270:   color:$button_hover;
                   6271: }
                   6272: 
1.870     tempelho 6273: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6274:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6275:   color:$font;
1.957     onken    6276:   border: 0;
1.956     onken    6277:   cursor:default;
1.741     harmsja  6278: }
1.693     droeschl 6279: 
1.870     tempelho 6280: 
1.862     bisitz   6281: ul.LC_CourseBreadcrumbs {
                   6282:   background: $sidebg;
                   6283:   line-height: 32px;
                   6284:   padding-left: 10px;
                   6285:   margin: 0 0 10px 0;
                   6286:   list-style-position: inside;
                   6287: 
                   6288: }
                   6289: 
1.911     bisitz   6290: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6291: ol#LC_PathBreadcrumbs {
1.911     bisitz   6292:   padding-left: 10px;
                   6293:   margin: 0;
1.933     droeschl 6294:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6295: }
                   6296: 
1.911     bisitz   6297: ol#LC_MenuBreadcrumbs li,
                   6298: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6299: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6300:   display: inline;
1.933     droeschl 6301:   white-space: normal;  
1.693     droeschl 6302: }
                   6303: 
1.823     bisitz   6304: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6305: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6306:   text-decoration: none;
                   6307:   font-size:90%;
1.693     droeschl 6308: }
1.795     www      6309: 
1.969     droeschl 6310: ol#LC_MenuBreadcrumbs h1 {
                   6311:   display: inline;
                   6312:   font-size: 90%;
                   6313:   line-height: 2.5em;
                   6314:   margin: 0;
                   6315:   padding: 0;
                   6316: }
                   6317: 
1.795     www      6318: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6319:   text-decoration:none;
                   6320:   font-size:100%;
                   6321:   font-weight:bold;
1.693     droeschl 6322: }
1.795     www      6323: 
1.840     bisitz   6324: .LC_Box {
1.911     bisitz   6325:   border: solid 1px $lg_border_color;
                   6326:   padding: 0 10px 10px 10px;
1.746     neumanie 6327: }
1.795     www      6328: 
                   6329: .LC_AboutMe_Image {
1.911     bisitz   6330:   float:left;
                   6331:   margin-right:10px;
1.747     neumanie 6332: }
1.795     www      6333: 
                   6334: .LC_Clear_AboutMe_Image {
1.911     bisitz   6335:   clear:left;
1.747     neumanie 6336: }
1.795     www      6337: 
1.721     harmsja  6338: dl.LC_ListStyleClean dt {
1.911     bisitz   6339:   padding-right: 5px;
                   6340:   display: table-header-group;
1.693     droeschl 6341: }
                   6342: 
1.721     harmsja  6343: dl.LC_ListStyleClean dd {
1.911     bisitz   6344:   display: table-row;
1.693     droeschl 6345: }
                   6346: 
1.721     harmsja  6347: .LC_ListStyleClean,
                   6348: .LC_ListStyleSimple,
                   6349: .LC_ListStyleNormal,
1.795     www      6350: .LC_ListStyleSpecial {
1.911     bisitz   6351:   /* display:block; */
                   6352:   list-style-position: inside;
                   6353:   list-style-type: none;
                   6354:   overflow: hidden;
                   6355:   padding: 0;
1.693     droeschl 6356: }
                   6357: 
1.721     harmsja  6358: .LC_ListStyleSimple li,
                   6359: .LC_ListStyleSimple dd,
                   6360: .LC_ListStyleNormal li,
                   6361: .LC_ListStyleNormal dd,
                   6362: .LC_ListStyleSpecial li,
1.795     www      6363: .LC_ListStyleSpecial dd {
1.911     bisitz   6364:   margin: 0;
                   6365:   padding: 5px 5px 5px 10px;
                   6366:   clear: both;
1.693     droeschl 6367: }
                   6368: 
1.721     harmsja  6369: .LC_ListStyleClean li,
                   6370: .LC_ListStyleClean dd {
1.911     bisitz   6371:   padding-top: 0;
                   6372:   padding-bottom: 0;
1.693     droeschl 6373: }
                   6374: 
1.721     harmsja  6375: .LC_ListStyleSimple dd,
1.795     www      6376: .LC_ListStyleSimple li {
1.911     bisitz   6377:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 6378: }
                   6379: 
1.721     harmsja  6380: .LC_ListStyleSpecial li,
                   6381: .LC_ListStyleSpecial dd {
1.911     bisitz   6382:   list-style-type: none;
                   6383:   background-color: RGB(220, 220, 220);
                   6384:   margin-bottom: 4px;
1.693     droeschl 6385: }
                   6386: 
1.721     harmsja  6387: table.LC_SimpleTable {
1.911     bisitz   6388:   margin:5px;
                   6389:   border:solid 1px $lg_border_color;
1.795     www      6390: }
1.693     droeschl 6391: 
1.721     harmsja  6392: table.LC_SimpleTable tr {
1.911     bisitz   6393:   padding: 0;
                   6394:   border:solid 1px $lg_border_color;
1.693     droeschl 6395: }
1.795     www      6396: 
                   6397: table.LC_SimpleTable thead {
1.911     bisitz   6398:   background:rgb(220,220,220);
1.693     droeschl 6399: }
                   6400: 
1.721     harmsja  6401: div.LC_columnSection {
1.911     bisitz   6402:   display: block;
                   6403:   clear: both;
                   6404:   overflow: hidden;
                   6405:   margin: 0;
1.693     droeschl 6406: }
                   6407: 
1.721     harmsja  6408: div.LC_columnSection>* {
1.911     bisitz   6409:   float: left;
                   6410:   margin: 10px 20px 10px 0;
                   6411:   overflow:hidden;
1.693     droeschl 6412: }
1.721     harmsja  6413: 
1.795     www      6414: table em {
1.911     bisitz   6415:   font-weight: bold;
                   6416:   font-style: normal;
1.748     schulted 6417: }
1.795     www      6418: 
1.779     bisitz   6419: table.LC_tableBrowseRes,
1.795     www      6420: table.LC_tableOfContent {
1.911     bisitz   6421:   border:none;
                   6422:   border-spacing: 1px;
                   6423:   padding: 3px;
                   6424:   background-color: #FFFFFF;
                   6425:   font-size: 90%;
1.753     droeschl 6426: }
1.789     droeschl 6427: 
1.911     bisitz   6428: table.LC_tableOfContent {
                   6429:   border-collapse: collapse;
1.789     droeschl 6430: }
                   6431: 
1.771     droeschl 6432: table.LC_tableBrowseRes a,
1.768     schulted 6433: table.LC_tableOfContent a {
1.911     bisitz   6434:   background-color: transparent;
                   6435:   text-decoration: none;
1.753     droeschl 6436: }
                   6437: 
1.795     www      6438: table.LC_tableOfContent img {
1.911     bisitz   6439:   border: none;
                   6440:   height: 1.3em;
                   6441:   vertical-align: text-bottom;
                   6442:   margin-right: 0.3em;
1.753     droeschl 6443: }
1.757     schulted 6444: 
1.795     www      6445: a#LC_content_toolbar_firsthomework {
1.911     bisitz   6446:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  6447: }
                   6448: 
1.795     www      6449: a#LC_content_toolbar_everything {
1.911     bisitz   6450:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  6451: }
                   6452: 
1.795     www      6453: a#LC_content_toolbar_uncompleted {
1.911     bisitz   6454:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  6455: }
                   6456: 
1.795     www      6457: #LC_content_toolbar_clearbubbles {
1.911     bisitz   6458:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  6459: }
                   6460: 
1.795     www      6461: a#LC_content_toolbar_changefolder {
1.911     bisitz   6462:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 6463: }
                   6464: 
1.795     www      6465: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   6466:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 6467: }
                   6468: 
1.795     www      6469: ul#LC_toolbar li a:hover {
1.911     bisitz   6470:   background-position: bottom center;
1.757     schulted 6471: }
                   6472: 
1.795     www      6473: ul#LC_toolbar {
1.911     bisitz   6474:   padding: 0;
                   6475:   margin: 2px;
                   6476:   list-style:none;
                   6477:   position:relative;
                   6478:   background-color:white;
1.757     schulted 6479: }
                   6480: 
1.795     www      6481: ul#LC_toolbar li {
1.911     bisitz   6482:   border:1px solid white;
                   6483:   padding: 0;
                   6484:   margin: 0;
                   6485:   float: left;
                   6486:   display:inline;
                   6487:   vertical-align:middle;
                   6488: }
1.757     schulted 6489: 
1.783     amueller 6490: 
1.795     www      6491: a.LC_toolbarItem {
1.911     bisitz   6492:   display:block;
                   6493:   padding: 0;
                   6494:   margin: 0;
                   6495:   height: 32px;
                   6496:   width: 32px;
                   6497:   color:white;
                   6498:   border: none;
                   6499:   background-repeat:no-repeat;
                   6500:   background-color:transparent;
1.757     schulted 6501: }
                   6502: 
1.915     droeschl 6503: ul.LC_funclist {
                   6504:     margin: 0;
                   6505:     padding: 0.5em 1em 0.5em 0;
                   6506: }
                   6507: 
1.933     droeschl 6508: ul.LC_funclist > li:first-child {
                   6509:     font-weight:bold; 
                   6510:     margin-left:0.8em;
                   6511: }
                   6512: 
1.915     droeschl 6513: ul.LC_funclist + ul.LC_funclist {
                   6514:     /* 
                   6515:        left border as a seperator if we have more than
                   6516:        one list 
                   6517:     */
                   6518:     border-left: 1px solid $sidebg;
                   6519:     /* 
                   6520:        this hides the left border behind the border of the 
                   6521:        outer box if element is wrapped to the next 'line' 
                   6522:     */
                   6523:     margin-left: -1px;
                   6524: }
                   6525: 
1.843     bisitz   6526: ul.LC_funclist li {
1.915     droeschl 6527:   display: inline;
1.782     bisitz   6528:   white-space: nowrap;
1.915     droeschl 6529:   margin: 0 0 0 25px;
                   6530:   line-height: 150%;
1.782     bisitz   6531: }
                   6532: 
1.930     faziophi 6533: .ui-accordion .LC_advanced_toggle {
                   6534:   float: right;
                   6535:   font-size: 90%;
                   6536:   padding: 0px 4px
                   6537: }
1.757     schulted 6538: 
1.974     wenzelju 6539: .LC_hidden {
                   6540:   display: none;
                   6541: }
                   6542: 
1.343     albertel 6543: END
                   6544: }
                   6545: 
1.306     albertel 6546: =pod
                   6547: 
                   6548: =item * &headtag()
                   6549: 
                   6550: Returns a uniform footer for LON-CAPA web pages.
                   6551: 
1.307     albertel 6552: Inputs: $title - optional title for the head
                   6553:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 6554:         $args - optional arguments
1.319     albertel 6555:             force_register - if is true call registerurl so the remote is 
                   6556:                              informed
1.415     albertel 6557:             redirect       -> array ref of
                   6558:                                    1- seconds before redirect occurs
                   6559:                                    2- url to redirect to
                   6560:                                    3- whether the side effect should occur
1.315     albertel 6561:                            (side effect of setting 
                   6562:                                $env{'internal.head.redirect'} to the url 
                   6563:                                redirected too)
1.352     albertel 6564:             domain         -> force to color decorate a page for a specific
                   6565:                                domain
                   6566:             function       -> force usage of a specific rolish color scheme
                   6567:             bgcolor        -> override the default page bgcolor
1.460     albertel 6568:             no_auto_mt_title
                   6569:                            -> prevent &mt()ing the title arg
1.464     albertel 6570: 
1.306     albertel 6571: =cut
                   6572: 
                   6573: sub headtag {
1.313     albertel 6574:     my ($title,$head_extra,$args) = @_;
1.306     albertel 6575:     
1.363     albertel 6576:     my $function = $args->{'function'} || &get_users_function();
                   6577:     my $domain   = $args->{'domain'}   || &determinedomain();
                   6578:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 6579:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 6580: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 6581: 		   #time(),
1.418     albertel 6582: 		   $env{'environment.color.timestamp'},
1.363     albertel 6583: 		   $function,$domain,$bgcolor);
                   6584: 
1.369     www      6585:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 6586: 
1.308     albertel 6587:     my $result =
                   6588: 	'<head>'.
1.461     albertel 6589: 	&font_settings();
1.319     albertel 6590: 
1.461     albertel 6591:     if (!$args->{'frameset'}) {
                   6592: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   6593:     }
1.962     droeschl 6594:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   6595:         $result .= Apache::lonxml::display_title();
1.319     albertel 6596:     }
1.436     albertel 6597:     if (!$args->{'no_nav_bar'} 
                   6598: 	&& !$args->{'only_body'}
                   6599: 	&& !$args->{'frameset'}) {
                   6600: 	$result .= &help_menu_js();
                   6601:     }
1.319     albertel 6602: 
1.314     albertel 6603:     if (ref($args->{'redirect'})) {
1.414     albertel 6604: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 6605: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 6606: 	if (!$inhibit_continue) {
                   6607: 	    $env{'internal.head.redirect'} = $url;
                   6608: 	}
1.313     albertel 6609: 	$result.=<<ADDMETA
                   6610: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 6611: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 6612: ADDMETA
                   6613:     }
1.306     albertel 6614:     if (!defined($title)) {
                   6615: 	$title = 'The LearningOnline Network with CAPA';
                   6616:     }
1.460     albertel 6617:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   6618:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 6619: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
                   6620: 	.$head_extra;
1.962     droeschl 6621:     return $result.'</head>';
1.306     albertel 6622: }
                   6623: 
                   6624: =pod
                   6625: 
1.340     albertel 6626: =item * &font_settings()
                   6627: 
                   6628: Returns neccessary <meta> to set the proper encoding
                   6629: 
                   6630: Inputs: none
                   6631: 
                   6632: =cut
                   6633: 
                   6634: sub font_settings {
                   6635:     my $headerstring='';
1.647     www      6636:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 6637: 	$headerstring.=
                   6638: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   6639:     }
                   6640:     return $headerstring;
                   6641: }
                   6642: 
1.341     albertel 6643: =pod
                   6644: 
                   6645: =item * &xml_begin()
                   6646: 
                   6647: Returns the needed doctype and <html>
                   6648: 
                   6649: Inputs: none
                   6650: 
                   6651: =cut
                   6652: 
                   6653: sub xml_begin {
                   6654:     my $output='';
                   6655: 
                   6656:     if ($env{'browser.mathml'}) {
                   6657: 	$output='<?xml version="1.0"?>'
                   6658:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   6659: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   6660:             
                   6661: #	    .'<!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">] >'
                   6662: 	    .'<!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">'
                   6663:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   6664: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   6665:     } else {
1.849     bisitz   6666: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   6667:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 6668:     }
                   6669:     return $output;
                   6670: }
1.340     albertel 6671: 
                   6672: =pod
                   6673: 
1.306     albertel 6674: =item * &start_page()
                   6675: 
                   6676: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   6677: 
1.648     raeburn  6678: Inputs:
                   6679: 
                   6680: =over 4
                   6681: 
                   6682: $title - optional title for the page
                   6683: 
                   6684: $head_extra - optional extra HTML to incude inside the <head>
                   6685: 
                   6686: $args - additional optional args supported are:
                   6687: 
                   6688: =over 8
                   6689: 
                   6690:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 6691:                                     arg on
1.814     bisitz   6692:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  6693:              add_entries    -> additional attributes to add to the  <body>
                   6694:              domain         -> force to color decorate a page for a 
1.317     albertel 6695:                                     specific domain
1.648     raeburn  6696:              function       -> force usage of a specific rolish color
1.317     albertel 6697:                                     scheme
1.648     raeburn  6698:              redirect       -> see &headtag()
                   6699:              bgcolor        -> override the default page bg color
                   6700:              js_ready       -> return a string ready for being used in 
1.317     albertel 6701:                                     a javascript writeln
1.648     raeburn  6702:              html_encode    -> return a string ready for being used in 
1.320     albertel 6703:                                     a html attribute
1.648     raeburn  6704:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 6705:                                     $forcereg arg
1.648     raeburn  6706:              frameset       -> if true will start with a <frameset>
1.330     albertel 6707:                                     rather than <body>
1.648     raeburn  6708:              skip_phases    -> hash ref of 
1.338     albertel 6709:                                     head -> skip the <html><head> generation
                   6710:                                     body -> skip all <body> generation
1.648     raeburn  6711:              no_auto_mt_title -> prevent &mt()ing the title arg
                   6712:              inherit_jsmath -> when creating popup window in a page,
                   6713:                                     should it have jsmath forced on by the
                   6714:                                     current page
1.867     kalberla 6715:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  6716:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.361     albertel 6717: 
1.648     raeburn  6718: =back
1.460     albertel 6719: 
1.648     raeburn  6720: =back
1.562     albertel 6721: 
1.306     albertel 6722: =cut
                   6723: 
                   6724: sub start_page {
1.309     albertel 6725:     my ($title,$head_extra,$args) = @_;
1.318     albertel 6726:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.964     droeschl 6727: #SD
                   6728: #I don't see why we copy certain elements of %$args to %head_args
                   6729: #head args is passed to headtag() and this routine only reads those
                   6730: #keys that are needed. There doesn't happen any writes or any processing
                   6731: #of other keys.
                   6732: #proposal: just pass $args to headtag instead of \%head_args and delete 
                   6733: #marked lines
                   6734: #<- MARK
1.313     albertel 6735:     my %head_args;
1.352     albertel 6736:     foreach my $arg ('redirect','force_register','domain','function',
1.460     albertel 6737: 		     'bgcolor','frameset','no_nav_bar','only_body',
                   6738: 		     'no_auto_mt_title') {
1.319     albertel 6739: 	if (defined($args->{$arg})) {
1.324     raeburn  6740: 	    $head_args{$arg} = $args->{$arg};
1.319     albertel 6741: 	}
1.313     albertel 6742:     }
1.964     droeschl 6743: #MARK ->
1.319     albertel 6744: 
1.315     albertel 6745:     $env{'internal.start_page'}++;
1.338     albertel 6746:     my $result;
1.964     droeschl 6747: 
1.338     albertel 6748:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.964     droeschl 6749:         $result .= 
                   6750:                   &xml_begin() . &headtag($title,$head_extra,\%head_args);
                   6751: #replace prev line by
                   6752: #                 &xml_begin() . &headtag($title, $head_extra, $args);
1.338     albertel 6753:     }
                   6754:     
                   6755:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   6756: 	if ($args->{'frameset'}) {
                   6757: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   6758: 						$args->{'add_entries'});
                   6759: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   6760:         } else {
                   6761:             $result .=
                   6762:                 &bodytag($title, 
                   6763:                          $args->{'function'},       $args->{'add_entries'},
                   6764:                          $args->{'only_body'},      $args->{'domain'},
                   6765:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.962     droeschl 6766:                          $args->{'bgcolor'},        $args);
1.831     bisitz   6767:         }
1.330     albertel 6768:     }
1.338     albertel 6769: 
1.315     albertel 6770:     if ($args->{'js_ready'}) {
1.713     kaisler  6771: 		$result = &js_ready($result);
1.315     albertel 6772:     }
1.320     albertel 6773:     if ($args->{'html_encode'}) {
1.713     kaisler  6774: 		$result = &html_encode($result);
                   6775:     }
                   6776: 
1.813     bisitz   6777:     # Preparation for new and consistent functionlist at top of screen
                   6778:     # if ($args->{'functionlist'}) {
                   6779:     #            $result .= &build_functionlist();
                   6780:     #}
                   6781: 
1.964     droeschl 6782:     # Don't add anything more if only_body wanted or in const space
                   6783:     return $result if    $args->{'only_body'} 
                   6784:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   6785: 
                   6786:     #Breadcrumbs
1.758     kaisler  6787:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   6788: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   6789: 		#if any br links exists, add them to the breadcrumbs
                   6790: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   6791: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   6792: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   6793: 			}
                   6794: 		}
                   6795: 
                   6796: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   6797: 		if(exists($args->{'bread_crumbs_component'})){
                   6798: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   6799: 		}else{
                   6800: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   6801: 		}
1.320     albertel 6802:     }
1.315     albertel 6803:     return $result;
1.306     albertel 6804: }
                   6805: 
                   6806: sub end_page {
1.315     albertel 6807:     my ($args) = @_;
                   6808:     $env{'internal.end_page'}++;
1.330     albertel 6809:     my $result;
1.335     albertel 6810:     if ($args->{'discussion'}) {
                   6811: 	my ($target,$parser);
                   6812: 	if (ref($args->{'discussion'})) {
                   6813: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   6814: 				$args->{'discussion'}{'parser'});
                   6815: 	}
                   6816: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   6817:     }
                   6818: 
1.330     albertel 6819:     if ($args->{'frameset'}) {
                   6820: 	$result .= '</frameset>';
                   6821:     } else {
1.635     raeburn  6822: 	$result .= &endbodytag($args);
1.330     albertel 6823:     }
                   6824:     $result .= "\n</html>";
                   6825: 
1.315     albertel 6826:     if ($args->{'js_ready'}) {
1.317     albertel 6827: 	$result = &js_ready($result);
1.315     albertel 6828:     }
1.335     albertel 6829: 
1.320     albertel 6830:     if ($args->{'html_encode'}) {
                   6831: 	$result = &html_encode($result);
                   6832:     }
1.335     albertel 6833: 
1.315     albertel 6834:     return $result;
                   6835: }
                   6836: 
1.320     albertel 6837: sub html_encode {
                   6838:     my ($result) = @_;
                   6839: 
1.322     albertel 6840:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 6841:     
                   6842:     return $result;
                   6843: }
1.317     albertel 6844: sub js_ready {
                   6845:     my ($result) = @_;
                   6846: 
1.323     albertel 6847:     $result =~ s/[\n\r]/ /xmsg;
                   6848:     $result =~ s/\\/\\\\/xmsg;
                   6849:     $result =~ s/'/\\'/xmsg;
1.372     albertel 6850:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 6851:     
                   6852:     return $result;
                   6853: }
                   6854: 
1.315     albertel 6855: sub validate_page {
                   6856:     if (  exists($env{'internal.start_page'})
1.316     albertel 6857: 	  &&     $env{'internal.start_page'} > 1) {
                   6858: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 6859: 				 $env{'internal.start_page'}.' '.
1.316     albertel 6860: 				 $ENV{'request.filename'});
1.315     albertel 6861:     }
                   6862:     if (  exists($env{'internal.end_page'})
1.316     albertel 6863: 	  &&     $env{'internal.end_page'} > 1) {
                   6864: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 6865: 				 $env{'internal.end_page'}.' '.
1.316     albertel 6866: 				 $env{'request.filename'});
1.315     albertel 6867:     }
                   6868:     if (     exists($env{'internal.start_page'})
                   6869: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 6870: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   6871: 				 $env{'request.filename'});
1.315     albertel 6872:     }
                   6873:     if (   ! exists($env{'internal.start_page'})
                   6874: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 6875: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   6876: 				 $env{'request.filename'});
1.315     albertel 6877:     }
1.306     albertel 6878: }
1.315     albertel 6879: 
1.318     albertel 6880: sub simple_error_page {
                   6881:     my ($r,$title,$msg) = @_;
                   6882:     my $page =
                   6883: 	&Apache::loncommon::start_page($title).
                   6884: 	&mt($msg).
                   6885: 	&Apache::loncommon::end_page();
                   6886:     if (ref($r)) {
                   6887: 	$r->print($page);
1.327     albertel 6888: 	return;
1.318     albertel 6889:     }
                   6890:     return $page;
                   6891: }
1.347     albertel 6892: 
                   6893: {
1.610     albertel 6894:     my @row_count;
1.961     onken    6895: 
                   6896:     sub start_data_table_count {
                   6897:         unshift(@row_count, 0);
                   6898:         return;
                   6899:     }
                   6900: 
                   6901:     sub end_data_table_count {
                   6902:         shift(@row_count);
                   6903:         return;
                   6904:     }
                   6905: 
1.347     albertel 6906:     sub start_data_table {
1.422     albertel 6907: 	my ($add_class) = @_;
                   6908: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.961     onken    6909: 	&start_data_table_count();
1.422     albertel 6910: 	return '<table class="'.$css_class.'">'."\n";
1.347     albertel 6911:     }
                   6912: 
                   6913:     sub end_data_table {
1.961     onken    6914: 	&end_data_table_count();
1.389     albertel 6915: 	return '</table>'."\n";;
1.347     albertel 6916:     }
                   6917: 
                   6918:     sub start_data_table_row {
1.974     wenzelju 6919: 	my ($add_class, $id) = @_;
1.610     albertel 6920: 	$row_count[0]++;
                   6921: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   6922: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 6923:         $id = (' id="'.$id.'"') unless ($id eq '');
                   6924:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 6925:     }
1.471     banghart 6926:     
                   6927:     sub continue_data_table_row {
1.974     wenzelju 6928: 	my ($add_class, $id) = @_;
1.610     albertel 6929: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 6930: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   6931:         $id = (' id="'.$id.'"') unless ($id eq '');
                   6932:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 6933:     }
1.347     albertel 6934: 
                   6935:     sub end_data_table_row {
1.389     albertel 6936: 	return '</tr>'."\n";;
1.347     albertel 6937:     }
1.367     www      6938: 
1.421     albertel 6939:     sub start_data_table_empty_row {
1.707     bisitz   6940: #	$row_count[0]++;
1.421     albertel 6941: 	return  '<tr class="LC_empty_row" >'."\n";;
                   6942:     }
                   6943: 
                   6944:     sub end_data_table_empty_row {
                   6945: 	return '</tr>'."\n";;
                   6946:     }
                   6947: 
1.367     www      6948:     sub start_data_table_header_row {
1.389     albertel 6949: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      6950:     }
                   6951: 
                   6952:     sub end_data_table_header_row {
1.389     albertel 6953: 	return '</tr>'."\n";;
1.367     www      6954:     }
1.890     droeschl 6955: 
                   6956:     sub data_table_caption {
                   6957:         my $caption = shift;
                   6958:         return "<caption class=\"LC_caption\">$caption</caption>";
                   6959:     }
1.347     albertel 6960: }
                   6961: 
1.548     albertel 6962: =pod
                   6963: 
                   6964: =item * &inhibit_menu_check($arg)
                   6965: 
                   6966: Checks for a inhibitmenu state and generates output to preserve it
                   6967: 
                   6968: Inputs:         $arg - can be any of
                   6969:                      - undef - in which case the return value is a string 
                   6970:                                to add  into arguments list of a uri
                   6971:                      - 'input' - in which case the return value is a HTML
                   6972:                                  <form> <input> field of type hidden to
                   6973:                                  preserve the value
                   6974:                      - a url - in which case the return value is the url with
                   6975:                                the neccesary cgi args added to preserve the
                   6976:                                inhibitmenu state
                   6977:                      - a ref to a url - no return value, but the string is
                   6978:                                         updated to include the neccessary cgi
                   6979:                                         args to preserve the inhibitmenu state
                   6980: 
                   6981: =cut
                   6982: 
                   6983: sub inhibit_menu_check {
                   6984:     my ($arg) = @_;
                   6985:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   6986:     if ($arg eq 'input') {
                   6987: 	if ($env{'form.inhibitmenu'}) {
                   6988: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   6989: 	} else {
                   6990: 	    return
                   6991: 	}
                   6992:     }
                   6993:     if ($env{'form.inhibitmenu'}) {
                   6994: 	if (ref($arg)) {
                   6995: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   6996: 	} elsif ($arg eq '') {
                   6997: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   6998: 	} else {
                   6999: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7000: 	}
                   7001:     }
                   7002:     if (!ref($arg)) {
                   7003: 	return $arg;
                   7004:     }
                   7005: }
                   7006: 
1.251     albertel 7007: ###############################################
1.182     matthew  7008: 
                   7009: =pod
                   7010: 
1.549     albertel 7011: =back
                   7012: 
                   7013: =head1 User Information Routines
                   7014: 
                   7015: =over 4
                   7016: 
1.405     albertel 7017: =item * &get_users_function()
1.182     matthew  7018: 
                   7019: Used by &bodytag to determine the current users primary role.
                   7020: Returns either 'student','coordinator','admin', or 'author'.
                   7021: 
                   7022: =cut
                   7023: 
                   7024: ###############################################
                   7025: sub get_users_function {
1.815     tempelho 7026:     my $function = 'norole';
1.818     tempelho 7027:     if ($env{'request.role'}=~/^(st)/) {
                   7028:         $function='student';
                   7029:     }
1.907     raeburn  7030:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  7031:         $function='coordinator';
                   7032:     }
1.258     albertel 7033:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  7034:         $function='admin';
                   7035:     }
1.826     bisitz   7036:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.182     matthew  7037:         ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
                   7038:         $function='author';
                   7039:     }
                   7040:     return $function;
1.54      www      7041: }
1.99      www      7042: 
                   7043: ###############################################
                   7044: 
1.233     raeburn  7045: =pod
                   7046: 
1.821     raeburn  7047: =item * &show_course()
                   7048: 
                   7049: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   7050: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   7051: 
                   7052: Inputs:
                   7053: None
                   7054: 
                   7055: Outputs:
                   7056: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   7057: 
                   7058: =cut
                   7059: 
                   7060: ###############################################
                   7061: sub show_course {
                   7062:     my $course = !$env{'user.adv'};
                   7063:     if (!$env{'user.adv'}) {
                   7064:         foreach my $env (keys(%env)) {
                   7065:             next if ($env !~ m/^user\.priv\./);
                   7066:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   7067:                 $course = 0;
                   7068:                 last;
                   7069:             }
                   7070:         }
                   7071:     }
                   7072:     return $course;
                   7073: }
                   7074: 
                   7075: ###############################################
                   7076: 
                   7077: =pod
                   7078: 
1.542     raeburn  7079: =item * &check_user_status()
1.274     raeburn  7080: 
                   7081: Determines current status of supplied role for a
                   7082: specific user. Roles can be active, previous or future.
                   7083: 
                   7084: Inputs: 
                   7085: user's domain, user's username, course's domain,
1.375     raeburn  7086: course's number, optional section ID.
1.274     raeburn  7087: 
                   7088: Outputs:
                   7089: role status: active, previous or future. 
                   7090: 
                   7091: =cut
                   7092: 
                   7093: sub check_user_status {
1.412     raeburn  7094:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.982     raeburn  7095:     my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
                   7096:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,$extra);
1.274     raeburn  7097:     my @uroles = keys %userinfo;
                   7098:     my $srchstr;
                   7099:     my $active_chk = 'none';
1.412     raeburn  7100:     my $now = time;
1.274     raeburn  7101:     if (@uroles > 0) {
1.908     raeburn  7102:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  7103:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   7104:         } else {
1.412     raeburn  7105:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   7106:         }
                   7107:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  7108:             my $role_end = 0;
                   7109:             my $role_start = 0;
                   7110:             $active_chk = 'active';
1.412     raeburn  7111:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   7112:                 $role_end = $1;
                   7113:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   7114:                     $role_start = $1;
1.274     raeburn  7115:                 }
                   7116:             }
                   7117:             if ($role_start > 0) {
1.412     raeburn  7118:                 if ($now < $role_start) {
1.274     raeburn  7119:                     $active_chk = 'future';
                   7120:                 }
                   7121:             }
                   7122:             if ($role_end > 0) {
1.412     raeburn  7123:                 if ($now > $role_end) {
1.274     raeburn  7124:                     $active_chk = 'previous';
                   7125:                 }
                   7126:             }
                   7127:         }
                   7128:     }
                   7129:     return $active_chk;
                   7130: }
                   7131: 
                   7132: ###############################################
                   7133: 
                   7134: =pod
                   7135: 
1.405     albertel 7136: =item * &get_sections()
1.233     raeburn  7137: 
                   7138: Determines all the sections for a course including
                   7139: sections with students and sections containing other roles.
1.419     raeburn  7140: Incoming parameters: 
                   7141: 
                   7142: 1. domain
                   7143: 2. course number 
                   7144: 3. reference to array containing roles for which sections should 
                   7145: be gathered (optional).
                   7146: 4. reference to array containing status types for which sections 
                   7147: should be gathered (optional).
                   7148: 
                   7149: If the third argument is undefined, sections are gathered for any role. 
                   7150: If the fourth argument is undefined, sections are gathered for any status.
                   7151: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  7152:  
1.374     raeburn  7153: Returns section hash (keys are section IDs, values are
                   7154: number of users in each section), subject to the
1.419     raeburn  7155: optional roles filter, optional status filter 
1.233     raeburn  7156: 
                   7157: =cut
                   7158: 
                   7159: ###############################################
                   7160: sub get_sections {
1.419     raeburn  7161:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 7162:     if (!defined($cdom) || !defined($cnum)) {
                   7163:         my $cid =  $env{'request.course.id'};
                   7164: 
                   7165: 	return if (!defined($cid));
                   7166: 
                   7167:         $cdom = $env{'course.'.$cid.'.domain'};
                   7168:         $cnum = $env{'course.'.$cid.'.num'};
                   7169:     }
                   7170: 
                   7171:     my %sectioncount;
1.419     raeburn  7172:     my $now = time;
1.240     albertel 7173: 
1.366     albertel 7174:     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276     albertel 7175: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 7176: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   7177: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  7178:         my $start_index = &Apache::loncoursedata::CL_START();
                   7179:         my $end_index = &Apache::loncoursedata::CL_END();
                   7180:         my $status;
1.366     albertel 7181: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  7182: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   7183: 				                     $data->[$status_index],
                   7184:                                                      $data->[$start_index],
                   7185:                                                      $data->[$end_index]);
                   7186:             if ($stu_status eq 'Active') {
                   7187:                 $status = 'active';
                   7188:             } elsif ($end < $now) {
                   7189:                 $status = 'previous';
                   7190:             } elsif ($start > $now) {
                   7191:                 $status = 'future';
                   7192:             } 
                   7193: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   7194:                 if ((!defined($possible_status)) || (($status ne '') && 
                   7195:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   7196: 		    $sectioncount{$section}++;
                   7197:                 }
1.240     albertel 7198: 	    }
                   7199: 	}
                   7200:     }
                   7201:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7202:     foreach my $user (sort(keys(%courseroles))) {
                   7203: 	if ($user !~ /^(\w{2})/) { next; }
                   7204: 	my ($role) = ($user =~ /^(\w{2})/);
                   7205: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  7206: 	my ($section,$status);
1.240     albertel 7207: 	if ($role eq 'cr' &&
                   7208: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   7209: 	    $section=$1;
                   7210: 	}
                   7211: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   7212: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  7213:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   7214:         if ($end == -1 && $start == -1) {
                   7215:             next; #deleted role
                   7216:         }
                   7217:         if (!defined($possible_status)) { 
                   7218:             $sectioncount{$section}++;
                   7219:         } else {
                   7220:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   7221:                 $status = 'active';
                   7222:             } elsif ($end < $now) {
                   7223:                 $status = 'future';
                   7224:             } elsif ($start > $now) {
                   7225:                 $status = 'previous';
                   7226:             }
                   7227:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   7228:                 $sectioncount{$section}++;
                   7229:             }
                   7230:         }
1.233     raeburn  7231:     }
1.366     albertel 7232:     return %sectioncount;
1.233     raeburn  7233: }
                   7234: 
1.274     raeburn  7235: ###############################################
1.294     raeburn  7236: 
                   7237: =pod
1.405     albertel 7238: 
                   7239: =item * &get_course_users()
                   7240: 
1.275     raeburn  7241: Retrieves usernames:domains for users in the specified course
                   7242: with specific role(s), and access status. 
                   7243: 
                   7244: Incoming parameters:
1.277     albertel 7245: 1. course domain
                   7246: 2. course number
                   7247: 3. access status: users must have - either active, 
1.275     raeburn  7248: previous, future, or all.
1.277     albertel 7249: 4. reference to array of permissible roles
1.288     raeburn  7250: 5. reference to array of section restrictions (optional)
                   7251: 6. reference to results object (hash of hashes).
                   7252: 7. reference to optional userdata hash
1.609     raeburn  7253: 8. reference to optional statushash
1.630     raeburn  7254: 9. flag if privileged users (except those set to unhide in
                   7255:    course settings) should be excluded    
1.609     raeburn  7256: Keys of top level results hash are roles.
1.275     raeburn  7257: Keys of inner hashes are username:domain, with 
                   7258: values set to access type.
1.288     raeburn  7259: Optional userdata hash returns an array with arguments in the 
                   7260: same order as loncoursedata::get_classlist() for student data.
                   7261: 
1.609     raeburn  7262: Optional statushash returns
                   7263: 
1.288     raeburn  7264: Entries for end, start, section and status are blank because
                   7265: of the possibility of multiple values for non-student roles.
                   7266: 
1.275     raeburn  7267: =cut
1.405     albertel 7268: 
1.275     raeburn  7269: ###############################################
1.405     albertel 7270: 
1.275     raeburn  7271: sub get_course_users {
1.630     raeburn  7272:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  7273:     my %idx = ();
1.419     raeburn  7274:     my %seclists;
1.288     raeburn  7275: 
                   7276:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   7277:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   7278:     $idx{end} = &Apache::loncoursedata::CL_END();
                   7279:     $idx{start} = &Apache::loncoursedata::CL_START();
                   7280:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   7281:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   7282:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   7283:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   7284: 
1.290     albertel 7285:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 7286:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  7287:         my $now = time;
1.277     albertel 7288:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  7289:             my $match = 0;
1.412     raeburn  7290:             my $secmatch = 0;
1.419     raeburn  7291:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  7292:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  7293:             if ($section eq '') {
                   7294:                 $section = 'none';
                   7295:             }
1.291     albertel 7296:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 7297:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  7298:                     $secmatch = 1;
                   7299:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 7300:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  7301:                         $secmatch = 1;
                   7302:                     }
                   7303:                 } else {  
1.419     raeburn  7304: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  7305: 		        $secmatch = 1;
                   7306:                     }
1.290     albertel 7307: 		}
1.412     raeburn  7308:                 if (!$secmatch) {
                   7309:                     next;
                   7310:                 }
1.419     raeburn  7311:             }
1.275     raeburn  7312:             if (defined($$types{'active'})) {
1.288     raeburn  7313:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  7314:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  7315:                     $match = 1;
1.275     raeburn  7316:                 }
                   7317:             }
                   7318:             if (defined($$types{'previous'})) {
1.609     raeburn  7319:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  7320:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  7321:                     $match = 1;
1.275     raeburn  7322:                 }
                   7323:             }
                   7324:             if (defined($$types{'future'})) {
1.609     raeburn  7325:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  7326:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  7327:                     $match = 1;
1.275     raeburn  7328:                 }
                   7329:             }
1.609     raeburn  7330:             if ($match) {
                   7331:                 push(@{$seclists{$student}},$section);
                   7332:                 if (ref($userdata) eq 'HASH') {
                   7333:                     $$userdata{$student} = $$classlist{$student};
                   7334:                 }
                   7335:                 if (ref($statushash) eq 'HASH') {
                   7336:                     $statushash->{$student}{'st'}{$section} = $status;
                   7337:                 }
1.288     raeburn  7338:             }
1.275     raeburn  7339:         }
                   7340:     }
1.412     raeburn  7341:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  7342:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7343:         my $now = time;
1.609     raeburn  7344:         my %displaystatus = ( previous => 'Expired',
                   7345:                               active   => 'Active',
                   7346:                               future   => 'Future',
                   7347:                             );
1.630     raeburn  7348:         my %nothide;
                   7349:         if ($hidepriv) {
                   7350:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   7351:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   7352:                 if ($user !~ /:/) {
                   7353:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   7354:                 } else {
                   7355:                     $nothide{$user} = 1;
                   7356:                 }
                   7357:             }
                   7358:         }
1.439     raeburn  7359:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  7360:             my $match = 0;
1.412     raeburn  7361:             my $secmatch = 0;
1.439     raeburn  7362:             my $status;
1.412     raeburn  7363:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  7364:             $user =~ s/:$//;
1.439     raeburn  7365:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   7366:             if ($end == -1 || $start == -1) {
                   7367:                 next;
                   7368:             }
                   7369:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   7370:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  7371:                 my ($uname,$udom) = split(/:/,$user);
                   7372:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 7373:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  7374:                         $secmatch = 1;
                   7375:                     } elsif ($usec eq '') {
1.420     albertel 7376:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  7377:                             $secmatch = 1;
                   7378:                         }
                   7379:                     } else {
                   7380:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   7381:                             $secmatch = 1;
                   7382:                         }
                   7383:                     }
                   7384:                     if (!$secmatch) {
                   7385:                         next;
                   7386:                     }
1.288     raeburn  7387:                 }
1.419     raeburn  7388:                 if ($usec eq '') {
                   7389:                     $usec = 'none';
                   7390:                 }
1.275     raeburn  7391:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  7392:                     if ($hidepriv) {
                   7393:                         if ((&Apache::lonnet::privileged($uname,$udom)) &&
                   7394:                             (!$nothide{$uname.':'.$udom})) {
                   7395:                             next;
                   7396:                         }
                   7397:                     }
1.503     raeburn  7398:                     if ($end > 0 && $end < $now) {
1.439     raeburn  7399:                         $status = 'previous';
                   7400:                     } elsif ($start > $now) {
                   7401:                         $status = 'future';
                   7402:                     } else {
                   7403:                         $status = 'active';
                   7404:                     }
1.277     albertel 7405:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  7406:                         if ($status eq $type) {
1.420     albertel 7407:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  7408:                                 push(@{$$users{$role}{$user}},$type);
                   7409:                             }
1.288     raeburn  7410:                             $match = 1;
                   7411:                         }
                   7412:                     }
1.419     raeburn  7413:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   7414:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   7415: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   7416:                         }
1.420     albertel 7417:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  7418:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   7419:                         }
1.609     raeburn  7420:                         if (ref($statushash) eq 'HASH') {
                   7421:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   7422:                         }
1.275     raeburn  7423:                     }
                   7424:                 }
                   7425:             }
                   7426:         }
1.290     albertel 7427:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  7428:             if ((defined($cdom)) && (defined($cnum))) {
                   7429:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   7430:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   7431:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  7432:                     next if ($owner eq '');
                   7433:                     my ($ownername,$ownerdom);
                   7434:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   7435:                         $ownername = $1;
                   7436:                         $ownerdom = $2;
                   7437:                     } else {
                   7438:                         $ownername = $owner;
                   7439:                         $ownerdom = $cdom;
                   7440:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  7441:                     }
                   7442:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 7443:                     if (defined($userdata) && 
1.609     raeburn  7444: 			!exists($$userdata{$owner})) {
                   7445: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   7446:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   7447:                             push(@{$seclists{$owner}},'none');
                   7448:                         }
                   7449:                         if (ref($statushash) eq 'HASH') {
                   7450:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  7451:                         }
1.290     albertel 7452: 		    }
1.279     raeburn  7453:                 }
                   7454:             }
                   7455:         }
1.419     raeburn  7456:         foreach my $user (keys(%seclists)) {
                   7457:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   7458:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   7459:         }
1.275     raeburn  7460:     }
                   7461:     return;
                   7462: }
                   7463: 
1.288     raeburn  7464: sub get_user_info {
                   7465:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 7466:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   7467: 	&plainname($uname,$udom,'lastname');
1.291     albertel 7468:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  7469:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  7470:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   7471:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  7472:     return;
                   7473: }
1.275     raeburn  7474: 
1.472     raeburn  7475: ###############################################
                   7476: 
                   7477: =pod
                   7478: 
                   7479: =item * &get_user_quota()
                   7480: 
                   7481: Retrieves quota assigned for storage of portfolio files for a user  
                   7482: 
                   7483: Incoming parameters:
                   7484: 1. user's username
                   7485: 2. user's domain
                   7486: 
                   7487: Returns:
1.536     raeburn  7488: 1. Disk quota (in Mb) assigned to student.
                   7489: 2. (Optional) Type of setting: custom or default
                   7490:    (individually assigned or default for user's 
                   7491:    institutional status).
                   7492: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   7493:    or student - types as defined in localenroll::inst_usertypes 
                   7494:    for user's domain, which determines default quota for user.
                   7495: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  7496: 
                   7497: If a value has been stored in the user's environment, 
1.536     raeburn  7498: it will return that, otherwise it returns the maximal default
                   7499: defined for the user's instituional status(es) in the domain.
1.472     raeburn  7500: 
                   7501: =cut
                   7502: 
                   7503: ###############################################
                   7504: 
                   7505: 
                   7506: sub get_user_quota {
                   7507:     my ($uname,$udom) = @_;
1.536     raeburn  7508:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  7509:     if (!defined($udom)) {
                   7510:         $udom = $env{'user.domain'};
                   7511:     }
                   7512:     if (!defined($uname)) {
                   7513:         $uname = $env{'user.name'};
                   7514:     }
                   7515:     if (($udom eq '' || $uname eq '') ||
                   7516:         ($udom eq 'public') && ($uname eq 'public')) {
                   7517:         $quota = 0;
1.536     raeburn  7518:         $quotatype = 'default';
                   7519:         $defquota = 0; 
1.472     raeburn  7520:     } else {
1.536     raeburn  7521:         my $inststatus;
1.472     raeburn  7522:         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   7523:             $quota = $env{'environment.portfolioquota'};
1.536     raeburn  7524:             $inststatus = $env{'environment.inststatus'};
1.472     raeburn  7525:         } else {
1.536     raeburn  7526:             my %userenv = 
                   7527:                 &Apache::lonnet::get('environment',['portfolioquota',
                   7528:                                      'inststatus'],$udom,$uname);
1.472     raeburn  7529:             my ($tmp) = keys(%userenv);
                   7530:             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   7531:                 $quota = $userenv{'portfolioquota'};
1.536     raeburn  7532:                 $inststatus = $userenv{'inststatus'};
1.472     raeburn  7533:             } else {
                   7534:                 undef(%userenv);
                   7535:             }
                   7536:         }
1.536     raeburn  7537:         ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472     raeburn  7538:         if ($quota eq '') {
1.536     raeburn  7539:             $quota = $defquota;
                   7540:             $quotatype = 'default';
                   7541:         } else {
                   7542:             $quotatype = 'custom';
1.472     raeburn  7543:         }
                   7544:     }
1.536     raeburn  7545:     if (wantarray) {
                   7546:         return ($quota,$quotatype,$settingstatus,$defquota);
                   7547:     } else {
                   7548:         return $quota;
                   7549:     }
1.472     raeburn  7550: }
                   7551: 
                   7552: ###############################################
                   7553: 
                   7554: =pod
                   7555: 
                   7556: =item * &default_quota()
                   7557: 
1.536     raeburn  7558: Retrieves default quota assigned for storage of user portfolio files,
                   7559: given an (optional) user's institutional status.
1.472     raeburn  7560: 
                   7561: Incoming parameters:
                   7562: 1. domain
1.536     raeburn  7563: 2. (Optional) institutional status(es).  This is a : separated list of 
                   7564:    status types (e.g., faculty, staff, student etc.)
                   7565:    which apply to the user for whom the default is being retrieved.
                   7566:    If the institutional status string in undefined, the domain
                   7567:    default quota will be returned. 
1.472     raeburn  7568: 
                   7569: Returns:
                   7570: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  7571: 2. (Optional) institutional type which determined the value of the
                   7572:    default quota.
1.472     raeburn  7573: 
                   7574: If a value has been stored in the domain's configuration db,
                   7575: it will return that, otherwise it returns 20 (for backwards 
                   7576: compatibility with domains which have not set up a configuration
                   7577: db file; the original statically defined portfolio quota was 20 Mb). 
                   7578: 
1.536     raeburn  7579: If the user's status includes multiple types (e.g., staff and student),
                   7580: the largest default quota which applies to the user determines the
                   7581: default quota returned.
                   7582: 
1.780     raeburn  7583: =back
                   7584: 
1.472     raeburn  7585: =cut
                   7586: 
                   7587: ###############################################
                   7588: 
                   7589: 
                   7590: sub default_quota {
1.536     raeburn  7591:     my ($udom,$inststatus) = @_;
                   7592:     my ($defquota,$settingstatus);
                   7593:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  7594:                                             ['quotas'],$udom);
                   7595:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  7596:         if ($inststatus ne '') {
1.765     raeburn  7597:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  7598:             foreach my $item (@statuses) {
1.711     raeburn  7599:                 if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   7600:                     if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
                   7601:                         if ($defquota eq '') {
                   7602:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   7603:                             $settingstatus = $item;
                   7604:                         } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
                   7605:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   7606:                             $settingstatus = $item;
                   7607:                         }
                   7608:                     }
                   7609:                 } else {
                   7610:                     if ($quotahash{'quotas'}{$item} ne '') {
                   7611:                         if ($defquota eq '') {
                   7612:                             $defquota = $quotahash{'quotas'}{$item};
                   7613:                             $settingstatus = $item;
                   7614:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   7615:                             $defquota = $quotahash{'quotas'}{$item};
                   7616:                             $settingstatus = $item;
                   7617:                         }
1.536     raeburn  7618:                     }
                   7619:                 }
                   7620:             }
                   7621:         }
                   7622:         if ($defquota eq '') {
1.711     raeburn  7623:             if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   7624:                 $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
                   7625:             } else {
                   7626:                 $defquota = $quotahash{'quotas'}{'default'};
                   7627:             }
1.536     raeburn  7628:             $settingstatus = 'default';
                   7629:         }
                   7630:     } else {
                   7631:         $settingstatus = 'default';
                   7632:         $defquota = 20;
                   7633:     }
                   7634:     if (wantarray) {
                   7635:         return ($defquota,$settingstatus);
1.472     raeburn  7636:     } else {
1.536     raeburn  7637:         return $defquota;
1.472     raeburn  7638:     }
                   7639: }
                   7640: 
1.384     raeburn  7641: sub get_secgrprole_info {
                   7642:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   7643:     my %sections_count = &get_sections($cdom,$cnum);
                   7644:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   7645:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   7646:     my @groups = sort(keys(%curr_groups));
                   7647:     my $allroles = [];
                   7648:     my $rolehash;
                   7649:     my $accesshash = {
                   7650:                      active => 'Currently has access',
                   7651:                      future => 'Will have future access',
                   7652:                      previous => 'Previously had access',
                   7653:                   };
                   7654:     if ($needroles) {
                   7655:         $rolehash = {'all' => 'all'};
1.385     albertel 7656:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7657: 	if (&Apache::lonnet::error(%user_roles)) {
                   7658: 	    undef(%user_roles);
                   7659: 	}
                   7660:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  7661:             my ($role)=split(/\:/,$item,2);
                   7662:             if ($role eq 'cr') { next; }
                   7663:             if ($role =~ /^cr/) {
                   7664:                 $$rolehash{$role} = (split('/',$role))[3];
                   7665:             } else {
                   7666:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   7667:             }
                   7668:         }
                   7669:         foreach my $key (sort(keys(%{$rolehash}))) {
                   7670:             push(@{$allroles},$key);
                   7671:         }
                   7672:         push (@{$allroles},'st');
                   7673:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   7674:     }
                   7675:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   7676: }
                   7677: 
1.555     raeburn  7678: sub user_picker {
1.994   ! raeburn  7679:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  7680:     my $currdom = $dom;
                   7681:     my %curr_selected = (
                   7682:                         srchin => 'dom',
1.580     raeburn  7683:                         srchby => 'lastname',
1.555     raeburn  7684:                       );
                   7685:     my $srchterm;
1.625     raeburn  7686:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  7687:         if ($srch->{'srchby'} ne '') {
                   7688:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   7689:         }
                   7690:         if ($srch->{'srchin'} ne '') {
                   7691:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   7692:         }
                   7693:         if ($srch->{'srchtype'} ne '') {
                   7694:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   7695:         }
                   7696:         if ($srch->{'srchdomain'} ne '') {
                   7697:             $currdom = $srch->{'srchdomain'};
                   7698:         }
                   7699:         $srchterm = $srch->{'srchterm'};
                   7700:     }
                   7701:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  7702:                     'usr'       => 'Search criteria',
1.563     raeburn  7703:                     'doma'      => 'Domain/institution to search',
1.558     albertel 7704:                     'uname'     => 'username',
                   7705:                     'lastname'  => 'last name',
1.555     raeburn  7706:                     'lastfirst' => 'last name, first name',
1.558     albertel 7707:                     'crs'       => 'in this course',
1.576     raeburn  7708:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 7709:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  7710:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 7711:                     'exact'     => 'is',
                   7712:                     'contains'  => 'contains',
1.569     raeburn  7713:                     'begins'    => 'begins with',
1.571     raeburn  7714:                     'youm'      => "You must include some text to search for.",
                   7715:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   7716:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   7717:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   7718:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   7719:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   7720:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   7721:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  7722:                                        );
1.563     raeburn  7723:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   7724:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  7725: 
                   7726:     my @srchins = ('crs','dom','alc','instd');
                   7727: 
                   7728:     foreach my $option (@srchins) {
                   7729:         # FIXME 'alc' option unavailable until 
                   7730:         #       loncreateuser::print_user_query_page()
                   7731:         #       has been completed.
                   7732:         next if ($option eq 'alc');
1.880     raeburn  7733:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  7734:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  7735:         if ($curr_selected{'srchin'} eq $option) {
                   7736:             $srchinsel .= ' 
                   7737:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   7738:         } else {
                   7739:             $srchinsel .= '
                   7740:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   7741:         }
1.555     raeburn  7742:     }
1.563     raeburn  7743:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  7744: 
                   7745:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  7746:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  7747:         if ($curr_selected{'srchby'} eq $option) {
                   7748:             $srchbysel .= '
                   7749:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   7750:         } else {
                   7751:             $srchbysel .= '
                   7752:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   7753:          }
                   7754:     }
                   7755:     $srchbysel .= "\n  </select>\n";
                   7756: 
                   7757:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  7758:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  7759:         if ($curr_selected{'srchtype'} eq $option) {
                   7760:             $srchtypesel .= '
                   7761:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   7762:         } else {
                   7763:             $srchtypesel .= '
                   7764:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   7765:         }
                   7766:     }
                   7767:     $srchtypesel .= "\n  </select>\n";
                   7768: 
1.558     albertel 7769:     my ($newuserscript,$new_user_create);
1.994   ! raeburn  7770:     my $context_dom = $env{'request.role.domain'};
        !          7771:     if ($context eq 'requestcrs') {
        !          7772:         if ($env{'form.coursedom'} ne '') { 
        !          7773:             $context_dom = $env{'form.coursedom'};
        !          7774:         }
        !          7775:     }
1.556     raeburn  7776:     if ($forcenewuser) {
1.576     raeburn  7777:         if (ref($srch) eq 'HASH') {
1.994   ! raeburn  7778:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  7779:                 if ($cancreate) {
                   7780:                     $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>';
                   7781:                 } else {
1.799     bisitz   7782:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  7783:                     my %usertypetext = (
                   7784:                         official   => 'institutional',
                   7785:                         unofficial => 'non-institutional',
                   7786:                     );
1.799     bisitz   7787:                     $new_user_create = '<p class="LC_warning">'
                   7788:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   7789:                                       .' '
                   7790:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   7791:                                           ,'<a href="'.$helplink.'">','</a>')
                   7792:                                       .'</p><br />';
1.627     raeburn  7793:                 }
1.576     raeburn  7794:             }
                   7795:         }
                   7796: 
1.556     raeburn  7797:         $newuserscript = <<"ENDSCRIPT";
                   7798: 
1.570     raeburn  7799: function setSearch(createnew,callingForm) {
1.556     raeburn  7800:     if (createnew == 1) {
1.570     raeburn  7801:         for (var i=0; i<callingForm.srchby.length; i++) {
                   7802:             if (callingForm.srchby.options[i].value == 'uname') {
                   7803:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  7804:             }
                   7805:         }
1.570     raeburn  7806:         for (var i=0; i<callingForm.srchin.length; i++) {
                   7807:             if ( callingForm.srchin.options[i].value == 'dom') {
                   7808: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  7809:             }
                   7810:         }
1.570     raeburn  7811:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   7812:             if (callingForm.srchtype.options[i].value == 'exact') {
                   7813:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  7814:             }
                   7815:         }
1.570     raeburn  7816:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994   ! raeburn  7817:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  7818:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  7819:             }
                   7820:         }
                   7821:     }
                   7822: }
                   7823: ENDSCRIPT
1.558     albertel 7824: 
1.556     raeburn  7825:     }
                   7826: 
1.555     raeburn  7827:     my $output = <<"END_BLOCK";
1.556     raeburn  7828: <script type="text/javascript">
1.824     bisitz   7829: // <![CDATA[
1.570     raeburn  7830: function validateEntry(callingForm) {
1.558     albertel 7831: 
1.556     raeburn  7832:     var checkok = 1;
1.558     albertel 7833:     var srchin;
1.570     raeburn  7834:     for (var i=0; i<callingForm.srchin.length; i++) {
                   7835: 	if ( callingForm.srchin[i].checked ) {
                   7836: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 7837: 	}
                   7838:     }
                   7839: 
1.570     raeburn  7840:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   7841:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   7842:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   7843:     var srchterm =  callingForm.srchterm.value;
                   7844:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  7845:     var msg = "";
                   7846: 
                   7847:     if (srchterm == "") {
                   7848:         checkok = 0;
1.571     raeburn  7849:         msg += "$lt{'youm'}\\n";
1.556     raeburn  7850:     }
                   7851: 
1.569     raeburn  7852:     if (srchtype== 'begins') {
                   7853:         if (srchterm.length < 2) {
                   7854:             checkok = 0;
1.571     raeburn  7855:             msg += "$lt{'thte'}\\n";
1.569     raeburn  7856:         }
                   7857:     }
                   7858: 
1.556     raeburn  7859:     if (srchtype== 'contains') {
                   7860:         if (srchterm.length < 3) {
                   7861:             checkok = 0;
1.571     raeburn  7862:             msg += "$lt{'thet'}\\n";
1.556     raeburn  7863:         }
                   7864:     }
                   7865:     if (srchin == 'instd') {
                   7866:         if (srchdomain == '') {
                   7867:             checkok = 0;
1.571     raeburn  7868:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  7869:         }
                   7870:     }
                   7871:     if (srchin == 'dom') {
                   7872:         if (srchdomain == '') {
                   7873:             checkok = 0;
1.571     raeburn  7874:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  7875:         }
                   7876:     }
                   7877:     if (srchby == 'lastfirst') {
                   7878:         if (srchterm.indexOf(",") == -1) {
                   7879:             checkok = 0;
1.571     raeburn  7880:             msg += "$lt{'whus'}\\n";
1.556     raeburn  7881:         }
                   7882:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   7883:             checkok = 0;
1.571     raeburn  7884:             msg += "$lt{'whse'}\\n";
1.556     raeburn  7885:         }
                   7886:     }
                   7887:     if (checkok == 0) {
1.571     raeburn  7888:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  7889:         return;
                   7890:     }
                   7891:     if (checkok == 1) {
1.570     raeburn  7892:         callingForm.submit();
1.556     raeburn  7893:     }
                   7894: }
                   7895: 
                   7896: $newuserscript
                   7897: 
1.824     bisitz   7898: // ]]>
1.556     raeburn  7899: </script>
1.558     albertel 7900: 
                   7901: $new_user_create
                   7902: 
1.555     raeburn  7903: END_BLOCK
1.558     albertel 7904: 
1.876     raeburn  7905:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   7906:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   7907:                $domform.
                   7908:                &Apache::lonhtmlcommon::row_closure().
                   7909:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   7910:                $srchbysel.
                   7911:                $srchtypesel. 
                   7912:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   7913:                $srchinsel.
                   7914:                &Apache::lonhtmlcommon::row_closure(1). 
                   7915:                &Apache::lonhtmlcommon::end_pick_box().
                   7916:                '<br />';
1.555     raeburn  7917:     return $output;
                   7918: }
                   7919: 
1.612     raeburn  7920: sub user_rule_check {
1.615     raeburn  7921:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  7922:     my $response;
                   7923:     if (ref($usershash) eq 'HASH') {
                   7924:         foreach my $user (keys(%{$usershash})) {
                   7925:             my ($uname,$udom) = split(/:/,$user);
                   7926:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  7927:             my ($id,$newuser);
1.612     raeburn  7928:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  7929:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  7930:                 $id = $usershash->{$user}->{'id'};
                   7931:             }
                   7932:             my $inst_response;
                   7933:             if (ref($checks) eq 'HASH') {
                   7934:                 if (defined($checks->{'username'})) {
1.615     raeburn  7935:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  7936:                         &Apache::lonnet::get_instuser($udom,$uname);
                   7937:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  7938:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  7939:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   7940:                 }
1.615     raeburn  7941:             } else {
                   7942:                 ($inst_response,%{$inst_results->{$user}}) =
                   7943:                     &Apache::lonnet::get_instuser($udom,$uname);
                   7944:                 return;
1.612     raeburn  7945:             }
1.615     raeburn  7946:             if (!$got_rules->{$udom}) {
1.612     raeburn  7947:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   7948:                                                   ['usercreation'],$udom);
                   7949:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  7950:                     foreach my $item ('username','id') {
1.612     raeburn  7951:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   7952:                             $$curr_rules{$udom}{$item} = 
                   7953:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  7954:                         }
                   7955:                     }
                   7956:                 }
1.615     raeburn  7957:                 $got_rules->{$udom} = 1;  
1.585     raeburn  7958:             }
1.612     raeburn  7959:             foreach my $item (keys(%{$checks})) {
                   7960:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   7961:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   7962:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   7963:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   7964:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   7965:                                 if ($rule_check{$rule}) {
                   7966:                                     $$rulematch{$user}{$item} = $rule;
                   7967:                                     if ($inst_response eq 'ok') {
1.615     raeburn  7968:                                         if (ref($inst_results) eq 'HASH') {
                   7969:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   7970:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   7971:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   7972:                                                 }
1.612     raeburn  7973:                                             }
                   7974:                                         }
1.615     raeburn  7975:                                     }
                   7976:                                     last;
1.585     raeburn  7977:                                 }
                   7978:                             }
                   7979:                         }
                   7980:                     }
                   7981:                 }
                   7982:             }
                   7983:         }
                   7984:     }
1.612     raeburn  7985:     return;
                   7986: }
                   7987: 
                   7988: sub user_rule_formats {
                   7989:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   7990:     my %text = ( 
                   7991:                  'username' => 'Usernames',
                   7992:                  'id'       => 'IDs',
                   7993:                );
                   7994:     my $output;
                   7995:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   7996:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   7997:         if (@{$ruleorder} > 0) {
                   7998:             $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>';
                   7999:             foreach my $rule (@{$ruleorder}) {
                   8000:                 if (ref($curr_rules) eq 'ARRAY') {
                   8001:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   8002:                         if (ref($rules->{$rule}) eq 'HASH') {
                   8003:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   8004:                                         $rules->{$rule}{'desc'}.'</li>';
                   8005:                         }
                   8006:                     }
                   8007:                 }
                   8008:             }
                   8009:             $output .= '</ul>';
                   8010:         }
                   8011:     }
                   8012:     return $output;
                   8013: }
                   8014: 
                   8015: sub instrule_disallow_msg {
1.615     raeburn  8016:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  8017:     my $response;
                   8018:     my %text = (
                   8019:                   item   => 'username',
                   8020:                   items  => 'usernames',
                   8021:                   match  => 'matches',
                   8022:                   do     => 'does',
                   8023:                   action => 'a username',
                   8024:                   one    => 'one',
                   8025:                );
                   8026:     if ($count > 1) {
                   8027:         $text{'item'} = 'usernames';
                   8028:         $text{'match'} ='match';
                   8029:         $text{'do'} = 'do';
                   8030:         $text{'action'} = 'usernames',
                   8031:         $text{'one'} = 'ones';
                   8032:     }
                   8033:     if ($checkitem eq 'id') {
                   8034:         $text{'items'} = 'IDs';
                   8035:         $text{'item'} = 'ID';
                   8036:         $text{'action'} = 'an ID';
1.615     raeburn  8037:         if ($count > 1) {
                   8038:             $text{'item'} = 'IDs';
                   8039:             $text{'action'} = 'IDs';
                   8040:         }
1.612     raeburn  8041:     }
1.674     bisitz   8042:     $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  8043:     if ($mode eq 'upload') {
                   8044:         if ($checkitem eq 'username') {
                   8045:             $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'}.");
                   8046:         } elsif ($checkitem eq 'id') {
1.674     bisitz   8047:             $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  8048:         }
1.669     raeburn  8049:     } elsif ($mode eq 'selfcreate') {
                   8050:         if ($checkitem eq 'id') {
                   8051:             $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.");
                   8052:         }
1.615     raeburn  8053:     } else {
                   8054:         if ($checkitem eq 'username') {
                   8055:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   8056:         } elsif ($checkitem eq 'id') {
                   8057:             $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.");
                   8058:         }
1.612     raeburn  8059:     }
                   8060:     return $response;
1.585     raeburn  8061: }
                   8062: 
1.624     raeburn  8063: sub personal_data_fieldtitles {
                   8064:     my %fieldtitles = &Apache::lonlocal::texthash (
                   8065:                         id => 'Student/Employee ID',
                   8066:                         permanentemail => 'E-mail address',
                   8067:                         lastname => 'Last Name',
                   8068:                         firstname => 'First Name',
                   8069:                         middlename => 'Middle Name',
                   8070:                         generation => 'Generation',
                   8071:                         gen => 'Generation',
1.765     raeburn  8072:                         inststatus => 'Affiliation',
1.624     raeburn  8073:                    );
                   8074:     return %fieldtitles;
                   8075: }
                   8076: 
1.642     raeburn  8077: sub sorted_inst_types {
                   8078:     my ($dom) = @_;
                   8079:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   8080:     my $othertitle = &mt('All users');
                   8081:     if ($env{'request.course.id'}) {
1.668     raeburn  8082:         $othertitle  = &mt('Any users');
1.642     raeburn  8083:     }
                   8084:     my @types;
                   8085:     if (ref($order) eq 'ARRAY') {
                   8086:         @types = @{$order};
                   8087:     }
                   8088:     if (@types == 0) {
                   8089:         if (ref($usertypes) eq 'HASH') {
                   8090:             @types = sort(keys(%{$usertypes}));
                   8091:         }
                   8092:     }
                   8093:     if (keys(%{$usertypes}) > 0) {
                   8094:         $othertitle = &mt('Other users');
                   8095:     }
                   8096:     return ($othertitle,$usertypes,\@types);
                   8097: }
                   8098: 
1.645     raeburn  8099: sub get_institutional_codes {
                   8100:     my ($settings,$allcourses,$LC_code) = @_;
                   8101: # Get complete list of course sections to update
                   8102:     my @currsections = ();
                   8103:     my @currxlists = ();
                   8104:     my $coursecode = $$settings{'internal.coursecode'};
                   8105: 
                   8106:     if ($$settings{'internal.sectionnums'} ne '') {
                   8107:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   8108:     }
                   8109: 
                   8110:     if ($$settings{'internal.crosslistings'} ne '') {
                   8111:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   8112:     }
                   8113: 
                   8114:     if (@currxlists > 0) {
                   8115:         foreach (@currxlists) {
                   8116:             if (m/^([^:]+):(\w*)$/) {
                   8117:                 unless (grep/^$1$/,@{$allcourses}) {
                   8118:                     push @{$allcourses},$1;
                   8119:                     $$LC_code{$1} = $2;
                   8120:                 }
                   8121:             }
                   8122:         }
                   8123:     }
                   8124:  
                   8125:     if (@currsections > 0) {
                   8126:         foreach (@currsections) {
                   8127:             if (m/^(\w+):(\w*)$/) {
                   8128:                 my $sec = $coursecode.$1;
                   8129:                 my $lc_sec = $2;
                   8130:                 unless (grep/^$sec$/,@{$allcourses}) {
                   8131:                     push @{$allcourses},$sec;
                   8132:                     $$LC_code{$sec} = $lc_sec;
                   8133:                 }
                   8134:             }
                   8135:         }
                   8136:     }
                   8137:     return;
                   8138: }
                   8139: 
1.971     raeburn  8140: sub get_standard_codeitems {
                   8141:     return ('Year','Semester','Department','Number','Section');
                   8142: }
                   8143: 
1.112     bowersj2 8144: =pod
                   8145: 
1.780     raeburn  8146: =head1 Slot Helpers
                   8147: 
                   8148: =over 4
                   8149: 
                   8150: =item * sorted_slots()
                   8151: 
                   8152: Sorts an array of slot names in order of slot start time (earliest first). 
                   8153: 
                   8154: Inputs:
                   8155: 
                   8156: =over 4
                   8157: 
                   8158: slotsarr  - Reference to array of unsorted slot names.
                   8159: 
                   8160: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   8161: 
1.549     albertel 8162: =back
                   8163: 
1.780     raeburn  8164: Returns:
                   8165: 
                   8166: =over 4
                   8167: 
                   8168: sorted   - An array of slot names sorted by the start time of the slot.
                   8169: 
                   8170: =back
                   8171: 
                   8172: =back
                   8173: 
                   8174: =cut
                   8175: 
                   8176: 
                   8177: sub sorted_slots {
                   8178:     my ($slotsarr,$slots) = @_;
                   8179:     my @sorted;
                   8180:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   8181:         @sorted =
                   8182:             sort {
                   8183:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
                   8184:                          return $slots->{$a}{'starttime'} <=> $slots->{$b}{'starttime'}
                   8185:                      }
                   8186:                      if (ref($slots->{$a})) { return -1;}
                   8187:                      if (ref($slots->{$b})) { return 1;}
                   8188:                      return 0;
                   8189:                  } @{$slotsarr};
                   8190:     }
                   8191:     return @sorted;
                   8192: }
                   8193: 
                   8194: 
                   8195: =pod
                   8196: 
1.549     albertel 8197: =head1 HTTP Helpers
                   8198: 
                   8199: =over 4
                   8200: 
1.648     raeburn  8201: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 8202: 
1.258     albertel 8203: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 8204: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 8205: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 8206: 
                   8207: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   8208: $possible_names is an ref to an array of form element names.  As an example:
                   8209: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 8210: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 8211: 
                   8212: =cut
1.1       albertel 8213: 
1.6       albertel 8214: sub get_unprocessed_cgi {
1.25      albertel 8215:   my ($query,$possible_names)= @_;
1.26      matthew  8216:   # $Apache::lonxml::debug=1;
1.356     albertel 8217:   foreach my $pair (split(/&/,$query)) {
                   8218:     my ($name, $value) = split(/=/,$pair);
1.369     www      8219:     $name = &unescape($name);
1.25      albertel 8220:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   8221:       $value =~ tr/+/ /;
                   8222:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 8223:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 8224:     }
1.16      harris41 8225:   }
1.6       albertel 8226: }
                   8227: 
1.112     bowersj2 8228: =pod
                   8229: 
1.648     raeburn  8230: =item * &cacheheader() 
1.112     bowersj2 8231: 
                   8232: returns cache-controlling header code
                   8233: 
                   8234: =cut
                   8235: 
1.7       albertel 8236: sub cacheheader {
1.258     albertel 8237:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 8238:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   8239:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 8240:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   8241:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 8242:     return $output;
1.7       albertel 8243: }
                   8244: 
1.112     bowersj2 8245: =pod
                   8246: 
1.648     raeburn  8247: =item * &no_cache($r) 
1.112     bowersj2 8248: 
                   8249: specifies header code to not have cache
                   8250: 
                   8251: =cut
                   8252: 
1.9       albertel 8253: sub no_cache {
1.216     albertel 8254:     my ($r) = @_;
                   8255:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 8256: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 8257:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   8258:     $r->no_cache(1);
                   8259:     $r->header_out("Expires" => $date);
                   8260:     $r->header_out("Pragma" => "no-cache");
1.123     www      8261: }
                   8262: 
                   8263: sub content_type {
1.181     albertel 8264:     my ($r,$type,$charset) = @_;
1.299     foxr     8265:     if ($r) {
                   8266: 	#  Note that printout.pl calls this with undef for $r.
                   8267: 	&no_cache($r);
                   8268:     }
1.258     albertel 8269:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 8270:     unless ($charset) {
                   8271: 	$charset=&Apache::lonlocal::current_encoding;
                   8272:     }
                   8273:     if ($charset) { $type.='; charset='.$charset; }
                   8274:     if ($r) {
                   8275: 	$r->content_type($type);
                   8276:     } else {
                   8277: 	print("Content-type: $type\n\n");
                   8278:     }
1.9       albertel 8279: }
1.25      albertel 8280: 
1.112     bowersj2 8281: =pod
                   8282: 
1.648     raeburn  8283: =item * &add_to_env($name,$value) 
1.112     bowersj2 8284: 
1.258     albertel 8285: adds $name to the %env hash with value
1.112     bowersj2 8286: $value, if $name already exists, the entry is converted to an array
                   8287: reference and $value is added to the array.
                   8288: 
                   8289: =cut
                   8290: 
1.25      albertel 8291: sub add_to_env {
                   8292:   my ($name,$value)=@_;
1.258     albertel 8293:   if (defined($env{$name})) {
                   8294:     if (ref($env{$name})) {
1.25      albertel 8295:       #already have multiple values
1.258     albertel 8296:       push(@{ $env{$name} },$value);
1.25      albertel 8297:     } else {
                   8298:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 8299:       my $first=$env{$name};
                   8300:       undef($env{$name});
                   8301:       push(@{ $env{$name} },$first,$value);
1.25      albertel 8302:     }
                   8303:   } else {
1.258     albertel 8304:     $env{$name}=$value;
1.25      albertel 8305:   }
1.31      albertel 8306: }
1.149     albertel 8307: 
                   8308: =pod
                   8309: 
1.648     raeburn  8310: =item * &get_env_multiple($name) 
1.149     albertel 8311: 
1.258     albertel 8312: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 8313: values may be defined and end up as an array ref.
                   8314: 
                   8315: returns an array of values
                   8316: 
                   8317: =cut
                   8318: 
                   8319: sub get_env_multiple {
                   8320:     my ($name) = @_;
                   8321:     my @values;
1.258     albertel 8322:     if (defined($env{$name})) {
1.149     albertel 8323:         # exists is it an array
1.258     albertel 8324:         if (ref($env{$name})) {
                   8325:             @values=@{ $env{$name} };
1.149     albertel 8326:         } else {
1.258     albertel 8327:             $values[0]=$env{$name};
1.149     albertel 8328:         }
                   8329:     }
                   8330:     return(@values);
                   8331: }
                   8332: 
1.660     raeburn  8333: sub ask_for_embedded_content {
                   8334:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.987     raeburn  8335:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges);
1.660     raeburn  8336:     my $num = 0;
1.987     raeburn  8337:     my $numremref = 0;
                   8338:     my $numinvalid = 0;
                   8339:     my $numpathchg = 0;
                   8340:     my $numexisting = 0;
                   8341:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath);
1.984     raeburn  8342:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   8343:         my $current_path='/';
                   8344:         if ($env{'form.currentpath'}) {
                   8345:             $current_path = $env{'form.currentpath'};
                   8346:         }
                   8347:         if ($actionurl eq '/adm/coursegrp_portfolio') {
                   8348:             $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   8349:             $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
                   8350:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   8351:         } else {
                   8352:             $udom = $env{'user.domain'};
                   8353:             $uname = $env{'user.name'};
                   8354:             $url = '/userfiles/portfolio';
                   8355:         }
1.987     raeburn  8356:         $toplevel = $url.'/';
1.984     raeburn  8357:         $url .= $current_path;
                   8358:         $getpropath = 1;
1.987     raeburn  8359:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   8360:              ($actionurl eq '/adm/imsimport')) { 
1.984     raeburn  8361:         ($uname,my $rest) = ($args->{'current_path'} =~ m{/priv/($match_username)/?(.*)$});
1.987     raeburn  8362:         $url = '/home/'.$uname.'/public_html/';
                   8363:         $toplevel = $url;
1.984     raeburn  8364:         if ($rest ne '') {
1.987     raeburn  8365:             $url .= $rest;
                   8366:         }
                   8367:     } elsif ($actionurl eq '/adm/coursedocs') {
                   8368:         if (ref($args) eq 'HASH') {
                   8369:            $url = $args->{'docs_url'};
                   8370:            $toplevel = $url;
                   8371:         }
                   8372:     }
                   8373:     my $now = time();
                   8374:     foreach my $embed_file (keys(%{$allfiles})) {
                   8375:         my $absolutepath;
                   8376:         if ($embed_file =~ m{^\w+://}) {
                   8377:             $newfiles{$embed_file} = 1;
                   8378:             $mapping{$embed_file} = $embed_file;
                   8379:         } else {
                   8380:             if ($embed_file =~ m{^/}) {
                   8381:                 $absolutepath = $embed_file;
                   8382:                 $embed_file =~ s{^(/+)}{};
                   8383:             }
                   8384:             if ($embed_file =~ m{/}) {
                   8385:                 my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
                   8386:                 $path = &check_for_traversal($path,$url,$toplevel);
                   8387:                 my $item = $fname;
                   8388:                 if ($path ne '') {
                   8389:                     $item = $path.'/'.$fname;
                   8390:                     $subdependencies{$path}{$fname} = 1;
                   8391:                 } else {
                   8392:                     $dependencies{$item} = 1;
                   8393:                 }
                   8394:                 if ($absolutepath) {
                   8395:                     $mapping{$item} = $absolutepath;
                   8396:                 } else {
                   8397:                     $mapping{$item} = $embed_file;
                   8398:                 }
                   8399:             } else {
                   8400:                 $dependencies{$embed_file} = 1;
                   8401:                 if ($absolutepath) {
                   8402:                     $mapping{$embed_file} = $absolutepath;
                   8403:                 } else {
                   8404:                     $mapping{$embed_file} = $embed_file;
                   8405:                 }
                   8406:             }
1.984     raeburn  8407:         }
                   8408:     }
                   8409:     foreach my $path (keys(%subdependencies)) {
                   8410:         my %currsubfile;
                   8411:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { 
                   8412:             my @subdir_list = &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   8413:             foreach my $line (@subdir_list) {
                   8414:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   8415:                 $currsubfile{$file_name} = 1;
                   8416:             }
1.987     raeburn  8417:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  8418:             if (opendir(my $dir,$url.'/'.$path)) {
                   8419:                 my @subdir_list = grep(!/^\./,readdir($dir));
                   8420:                 map {$currsubfile{$_} = 1;} @subdir_list;
                   8421:             }
                   8422:         }
                   8423:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.987     raeburn  8424:             if ($currsubfile{$file}) {
                   8425:                 my $item = $path.'/'.$file;
                   8426:                 unless ($mapping{$item} eq $item) {
                   8427:                     $pathchanges{$item} = 1;
                   8428:                 }
                   8429:                 $existing{$item} = 1;
                   8430:                 $numexisting ++;
                   8431:             } else {
                   8432:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  8433:             }
                   8434:         }
                   8435:     }
1.987     raeburn  8436:     my %currfile;
1.984     raeburn  8437:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   8438:         my @dir_list = &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   8439:         foreach my $line (@dir_list) {
                   8440:             my ($file_name,$rest) = split(/\&/,$line,2);
                   8441:             $currfile{$file_name} = 1;
                   8442:         }
1.987     raeburn  8443:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  8444:         if (opendir(my $dir,$url)) {
1.987     raeburn  8445:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  8446:             map {$currfile{$_} = 1;} @dir_list;
                   8447:         }
                   8448:     }
                   8449:     foreach my $file (keys(%dependencies)) {
1.987     raeburn  8450:         if ($currfile{$file}) {
                   8451:             unless ($mapping{$file} eq $file) {
                   8452:                 $pathchanges{$file} = 1;
                   8453:             }
                   8454:             $existing{$file} = 1;
                   8455:             $numexisting ++;
                   8456:         } else {
1.984     raeburn  8457:             $newfiles{$file} = 1;
                   8458:         }
                   8459:     }
                   8460:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.660     raeburn  8461:         $upload_output .= &start_data_table_row().
1.987     raeburn  8462:                           '<td><span class="LC_filename">'.$embed_file.'</span>';
                   8463:         unless ($mapping{$embed_file} eq $embed_file) {
                   8464:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
                   8465:         }
                   8466:         $upload_output .= '</td><td>';
1.660     raeburn  8467:         if ($args->{'ignore_remote_references'}
                   8468:             && $embed_file =~ m{^\w+://}) {
                   8469:             $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
1.987     raeburn  8470:             $numremref++;
1.660     raeburn  8471:         } elsif ($args->{'error_on_invalid_names'}
                   8472:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
                   8473: 
1.987     raeburn  8474:             $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';
                   8475:             $numinvalid++;
1.660     raeburn  8476:         } else {
1.987     raeburn  8477:             $upload_output .= &embedded_file_element('upload_embedded',$num,
                   8478:                                                      $embed_file,\%mapping,
                   8479:                                                      $allfiles,$codebase);
                   8480:             $num++;
                   8481:         }
                   8482:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   8483:     }
                   8484:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
                   8485:         $upload_output .= &start_data_table_row().
                   8486:                           '<td><span class="LC_filename">'.$embed_file.'</span></td>'.
                   8487:                           '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.
                   8488:                           &Apache::loncommon::end_data_table_row()."\n";
                   8489:     }
                   8490:     if ($upload_output) {
                   8491:         $upload_output = &start_data_table().
                   8492:                          $upload_output.
                   8493:                          &end_data_table()."\n";
                   8494:     }
                   8495:     my $applies = 0;
                   8496:     if ($numremref) {
                   8497:         $applies ++;
                   8498:     }
                   8499:     if ($numinvalid) {
                   8500:         $applies ++;
                   8501:     }
                   8502:     if ($numexisting) {
                   8503:         $applies ++;
                   8504:     }
                   8505:     if ($num) {
                   8506:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   8507:                   ' method="post" enctype="multipart/form-data">'."\n".
                   8508:                   $state.
                   8509:                   '<h3>'.&mt('Upload embedded files').
                   8510:                   ':</h3>'.$upload_output.'<br />'."\n".
                   8511:                   '<input type ="hidden" name="number_embedded_items" value="'.
                   8512:                   $num.'" />'."\n";
                   8513:         if ($actionurl eq '') {
                   8514:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   8515:         }
                   8516:     } elsif ($applies) {
                   8517:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   8518:         if ($applies > 1) {
                   8519:             $output .=  
                   8520:                 &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';
                   8521:             if ($numremref) {
                   8522:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   8523:             }
                   8524:             if ($numinvalid) {
                   8525:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   8526:             }
                   8527:             if ($numexisting) {
                   8528:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   8529:             }
                   8530:             $output .= '</ul><br />';
                   8531:         } elsif ($numremref) {
                   8532:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   8533:         } elsif ($numinvalid) {
                   8534:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   8535:         } elsif ($numexisting) {
                   8536:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   8537:         }
                   8538:         $output .= $upload_output.'<br />';
                   8539:     }
                   8540:     my ($pathchange_output,$chgcount);
                   8541:     $chgcount = $num;
                   8542:     if (keys(%pathchanges) > 0) {
                   8543:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
                   8544:             if ($num) {
                   8545:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   8546:                                                   $embed_file,\%mapping,
                   8547:                                                   $allfiles,$codebase);
                   8548:             } else {
                   8549:                 $pathchange_output .= 
                   8550:                     &start_data_table_row().
                   8551:                     '<td><input type ="checkbox" name="namechange" value="'.
                   8552:                     $chgcount.'" checked="checked" /></td>'.
                   8553:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   8554:                     '<td>'.$embed_file.
                   8555:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
                   8556:                                            \%mapping,$allfiles,$codebase).
                   8557:                     '</td>'.&end_data_table_row();
1.660     raeburn  8558:             }
1.987     raeburn  8559:             $numpathchg ++;
                   8560:             $chgcount ++;
1.660     raeburn  8561:         }
                   8562:     }
1.984     raeburn  8563:     if ($num) {
1.987     raeburn  8564:         if ($numpathchg) {
                   8565:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   8566:                        $numpathchg.'" />'."\n";
                   8567:         }
                   8568:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   8569:             ($actionurl eq '/adm/imsimport')) {
                   8570:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   8571:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   8572:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
                   8573:         }
                   8574:         $output .=  '<input type ="submit" value="'.&mt('Upload Listed Files').'" />'."\n".
                   8575:                     &mt('(only files for which a location has been provided will be uploaded)').'</form>'."\n";
                   8576:     } elsif ($numpathchg) {
                   8577:         my %pathchange = ();
                   8578:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   8579:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   8580:             $output .= '<p>'.&mt('or').'</p>'; 
                   8581:         } 
                   8582:     }
                   8583:     return ($output,$num,$numpathchg);
                   8584: }
                   8585: 
                   8586: sub embedded_file_element {
                   8587:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase) = @_;
                   8588:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   8589:                    (ref($codebase) eq 'HASH'));
                   8590:     my $output;
                   8591:     if ($context eq 'upload_embedded') {
                   8592:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   8593:     }
                   8594:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   8595:                &escape($embed_file).'" />';
                   8596:     unless (($context eq 'upload_embedded') && 
                   8597:             ($mapping->{$embed_file} eq $embed_file)) {
                   8598:         $output .='
                   8599:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   8600:     }
                   8601:     my $attrib;
                   8602:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   8603:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   8604:     }
                   8605:     $output .=
                   8606:         "\n\t\t".
                   8607:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   8608:         $attrib.'" />';
                   8609:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   8610:         $output .=
                   8611:             "\n\t\t".
                   8612:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   8613:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  8614:     }
1.987     raeburn  8615:     return $output;
1.660     raeburn  8616: }
                   8617: 
1.661     raeburn  8618: sub upload_embedded {
                   8619:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  8620:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   8621:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  8622:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   8623:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   8624:         my $orig_uploaded_filename =
                   8625:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  8626:         foreach my $type ('orig','ref','attrib','codebase') {
                   8627:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   8628:                 $env{'form.embedded_'.$type.'_'.$i} =
                   8629:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   8630:             }
                   8631:         }
1.661     raeburn  8632:         my ($path,$fname) =
                   8633:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   8634:         # no path, whole string is fname
                   8635:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   8636:         $fname = &Apache::lonnet::clean_filename($fname);
                   8637:         # See if there is anything left
                   8638:         next if ($fname eq '');
                   8639: 
                   8640:         # Check if file already exists as a file or directory.
                   8641:         my ($state,$msg);
                   8642:         if ($context eq 'portfolio') {
                   8643:             my $port_path = $dirpath;
                   8644:             if ($group ne '') {
                   8645:                 $port_path = "groups/$group/$port_path";
                   8646:             }
1.987     raeburn  8647:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   8648:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  8649:                                               $dir_root,$port_path,$disk_quota,
                   8650:                                               $current_disk_usage,$uname,$udom);
                   8651:             if ($state eq 'will_exceed_quota'
1.984     raeburn  8652:                 || $state eq 'file_locked') {
1.661     raeburn  8653:                 $output .= $msg;
                   8654:                 next;
                   8655:             }
                   8656:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   8657:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   8658:             if ($state eq 'exists') {
                   8659:                 $output .= $msg;
                   8660:                 next;
                   8661:             }
                   8662:         }
                   8663:         # Check if extension is valid
                   8664:         if (($fname =~ /\.(\w+)$/) &&
                   8665:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987     raeburn  8666:             $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  8667:             next;
                   8668:         } elsif (($fname =~ /\.(\w+)$/) &&
                   8669:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  8670:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  8671:             next;
                   8672:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.987     raeburn  8673:             $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  8674:             next;
                   8675:         }
                   8676: 
                   8677:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
                   8678:         if ($context eq 'portfolio') {
1.984     raeburn  8679:             my $result;
                   8680:             if ($state eq 'existingfile') {
                   8681:                 $result=
                   8682:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.987     raeburn  8683:                                                     $dirpath.$env{'form.currentpath'}.$path);
1.661     raeburn  8684:             } else {
1.984     raeburn  8685:                 $result=
                   8686:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  8687:                                                     $dirpath.
                   8688:                                                     $env{'form.currentpath'}.$path);
1.984     raeburn  8689:                 if ($result !~ m|^/uploaded/|) {
                   8690:                     $output .= '<span class="LC_error">'
                   8691:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   8692:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   8693:                                .'</span><br />';
                   8694:                     next;
                   8695:                 } else {
1.987     raeburn  8696:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   8697:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  8698:                 }
1.661     raeburn  8699:             }
1.987     raeburn  8700:         } elsif ($context eq 'coursedoc') {
                   8701:             my $result =
                   8702:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
                   8703:                                                 $dirpath.'/'.$path);
                   8704:             if ($result !~ m|^/uploaded/|) {
                   8705:                 $output .= '<span class="LC_error">'
                   8706:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   8707:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   8708:                            .'</span><br />';
                   8709:                     next;
                   8710:             } else {
                   8711:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   8712:                            $path.$fname.'</span>').'<br />';
                   8713:             }
1.661     raeburn  8714:         } else {
                   8715: # Save the file
                   8716:             my $target = $env{'form.embedded_item_'.$i};
                   8717:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   8718:             my $dest = $fullpath.$fname;
                   8719:             my $url = $url_root.$dirpath.'/'.$path.$fname;
                   8720:             my @parts=split(/\//,$fullpath);
                   8721:             my $count;
                   8722:             my $filepath = $dir_root;
                   8723:             for ($count=4;$count<=$#parts;$count++) {
                   8724:                 $filepath .= "/$parts[$count]";
                   8725:                 if ((-e $filepath)!=1) {
                   8726:                     mkdir($filepath,0770);
                   8727:                 }
                   8728:             }
                   8729:             my $fh;
                   8730:             if (!open($fh,'>'.$dest)) {
                   8731:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   8732:                 $output .= '<span class="LC_error">'.
                   8733:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                   8734:                            '</span><br />';
                   8735:             } else {
                   8736:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   8737:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   8738:                     $output .= '<span class="LC_error">'.
                   8739:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                   8740:                               '</span><br />';
                   8741:                 } else {
1.987     raeburn  8742:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   8743:                                $url.'</span>').'<br />';
                   8744:                     unless ($context eq 'testbank') {
                   8745:                         $footer .= &mt('View embedded file: [_1]',
                   8746:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   8747:                     }
                   8748:                 }
                   8749:                 close($fh);
                   8750:             }
                   8751:         }
                   8752:         if ($env{'form.embedded_ref_'.$i}) {
                   8753:             $pathchange{$i} = 1;
                   8754:         }
                   8755:     }
                   8756:     if ($output) {
                   8757:         $output = '<p>'.$output.'</p>';
                   8758:     }
                   8759:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   8760:     $returnflag = 'ok';
                   8761:     if (keys(%pathchange) > 0) {
                   8762:         if ($context eq 'portfolio') {
                   8763:             $output .= '<p>'.&mt('or').'</p>';
                   8764:         } elsif ($context eq 'testbank') {
1.988     raeburn  8765:             $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  8766:             $returnflag = 'modify_orightml';
                   8767:         }
                   8768:     }
                   8769:     return ($output.$footer,$returnflag);
                   8770: }
                   8771: 
                   8772: sub modify_html_form {
                   8773:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   8774:     my $end = 0;
                   8775:     my $modifyform;
                   8776:     if ($context eq 'upload_embedded') {
                   8777:         return unless (ref($pathchange) eq 'HASH');
                   8778:         if ($env{'form.number_embedded_items'}) {
                   8779:             $end += $env{'form.number_embedded_items'};
                   8780:         }
                   8781:         if ($env{'form.number_pathchange_items'}) {
                   8782:             $end += $env{'form.number_pathchange_items'};
                   8783:         }
                   8784:         if ($end) {
                   8785:             for (my $i=0; $i<$end; $i++) {
                   8786:                 if ($i < $env{'form.number_embedded_items'}) {
                   8787:                     next unless($pathchange->{$i});
                   8788:                 }
                   8789:                 $modifyform .=
                   8790:                     &start_data_table_row().
                   8791:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   8792:                     'checked="checked" /></td>'.
                   8793:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   8794:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   8795:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   8796:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   8797:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   8798:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   8799:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   8800:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   8801:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   8802:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   8803:                     &end_data_table_row();
                   8804:             } 
                   8805:         }
                   8806:     } else {
                   8807:         $modifyform = $pathchgtable;
                   8808:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   8809:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   8810:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   8811:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   8812:         }
                   8813:     }
                   8814:     if ($modifyform) {
                   8815:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   8816:                '<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".
                   8817:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   8818:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   8819:                '</ol></p>'."\n".'<p>'.
                   8820:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   8821:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   8822:                &start_data_table()."\n".
                   8823:                &start_data_table_header_row().
                   8824:                '<th>'.&mt('Change?').'</th>'.
                   8825:                '<th>'.&mt('Current reference').'</th>'.
                   8826:                '<th>'.&mt('Required reference').'</th>'.
                   8827:                &end_data_table_header_row()."\n".
                   8828:                $modifyform.
                   8829:                &end_data_table().'<br />'."\n".$hiddenstate.
                   8830:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   8831:                '</form>'."\n";
                   8832:     }
                   8833:     return;
                   8834: }
                   8835: 
                   8836: sub modify_html_refs {
                   8837:     my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
                   8838:     my $container;
                   8839:     if ($context eq 'portfolio') {
                   8840:         $container = $env{'form.container'};
                   8841:     } elsif ($context eq 'coursedoc') {
                   8842:         $container = $env{'form.primaryurl'};
                   8843:     } else {
                   8844:         $container = $env{'form.filename'};
                   8845:         $container =~ s{^/priv/(\Q$uname\E)/(.*)}{/home/$1/public_html/$2};
                   8846:     }
                   8847:     my (%allfiles,%codebase,$output,$content);
                   8848:     my @changes = &get_env_multiple('form.namechange');
                   8849:     return unless (@changes > 0);
                   8850:     if (($context eq 'portfolio') || ($context eq 'coursedoc')) {
                   8851:         return unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/});
                   8852:         $content = &Apache::lonnet::getfile($container);
                   8853:         return if ($content eq '-1');
                   8854:     } else {
                   8855:         return unless ($container =~ /^\Q$dir_root\E/); 
                   8856:         if (open(my $fh,"<$container")) {
                   8857:             $content = join('', <$fh>);
                   8858:             close($fh);
                   8859:         } else {
                   8860:             return;
                   8861:         }
                   8862:     }
                   8863:     my ($count,$codebasecount) = (0,0);
                   8864:     my $mm = new File::MMagic;
                   8865:     my $mime_type = $mm->checktype_contents($content);
                   8866:     if ($mime_type eq 'text/html') {
                   8867:         my $parse_result = 
                   8868:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   8869:                                                     \%codebase,\$content);
                   8870:         if ($parse_result eq 'ok') {
                   8871:             foreach my $i (@changes) {
                   8872:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   8873:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   8874:                 if ($allfiles{$ref}) {
                   8875:                     my $newname =  $orig;
                   8876:                     my ($attrib_regexp,$codebase);
                   8877:                     my $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
                   8878:                     if ($attrib_regexp =~ /:/) {
                   8879:                         $attrib_regexp =~ s/\:/|/g;
                   8880:                     }
                   8881:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   8882:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   8883:                         $count += $numchg;
                   8884:                     }
                   8885:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
                   8886:                         my $codebase = &unescape($env{'form.embedded_codebase_'.$i});
                   8887:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   8888:                         $codebasecount ++;
                   8889:                     }
                   8890:                 }
                   8891:             }
                   8892:             if ($count || $codebasecount) {
                   8893:                 my $saveresult;
                   8894:                 if ($context eq 'portfolio' || $context eq 'coursedoc') {
                   8895:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   8896:                     if ($url eq $container) {
                   8897:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   8898:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   8899:                                             $count,'<span class="LC_filename">'.
                   8900:                                             $fname.'</span>').'</p>'; 
                   8901:                     } else {
                   8902:                          $output = '<p class="LC_error">'.
                   8903:                                    &mt('Error: update failed for: [_1].',
                   8904:                                    '<span class="LC_filename">'.
                   8905:                                    $container.'</span>').'</p>';
                   8906:                     }
                   8907:                 } else {
                   8908:                     if (open(my $fh,">$container")) {
                   8909:                         print $fh $content;
                   8910:                         close($fh);
                   8911:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   8912:                                   $count,'<span class="LC_filename">'.
                   8913:                                   $container.'</span>').'</p>';
1.661     raeburn  8914:                     } else {
1.987     raeburn  8915:                          $output = '<p class="LC_error">'.
                   8916:                                    &mt('Error: could not update [_1].',
                   8917:                                    '<span class="LC_filename">'.
                   8918:                                    $container.'</span>').'</p>';
1.661     raeburn  8919:                     }
                   8920:                 }
                   8921:             }
1.987     raeburn  8922:         } else {
                   8923:             &logthis('Failed to parse '.$container.
                   8924:                      ' to modify references: '.$parse_result);
1.661     raeburn  8925:         }
                   8926:     }
                   8927:     return $output;
                   8928: }
                   8929: 
                   8930: sub check_for_existing {
                   8931:     my ($path,$fname,$element) = @_;
                   8932:     my ($state,$msg);
                   8933:     if (-d $path.'/'.$fname) {
                   8934:         $state = 'exists';
                   8935:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   8936:     } elsif (-e $path.'/'.$fname) {
                   8937:         $state = 'exists';
                   8938:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   8939:     }
                   8940:     if ($state eq 'exists') {
                   8941:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   8942:     }
                   8943:     return ($state,$msg);
                   8944: }
                   8945: 
                   8946: sub check_for_upload {
                   8947:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   8948:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  8949:     my $filesize = length($env{'form.'.$element});
                   8950:     if (!$filesize) {
                   8951:         my $msg = '<span class="LC_error">'.
                   8952:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   8953:                       '<span class="LC_filename">'.$fname.'</span>',
                   8954:                       $filesize).'<br />'.
1.992     raeburn  8955:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />';
1.985     raeburn  8956:                   '</span>';
                   8957:         return ('zero_bytes',$msg);
                   8958:     }
                   8959:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  8960:     my $getpropath = 1;
                   8961:     my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,
                   8962:                                             $getpropath);
                   8963:     my $found_file = 0;
                   8964:     my $locked_file = 0;
1.991     raeburn  8965:     my @lockers;
                   8966:     my $navmap;
                   8967:     if ($env{'request.course.id'}) {
                   8968:         $navmap = Apache::lonnavmaps::navmap->new();
                   8969:     }
1.661     raeburn  8970:     foreach my $line (@dir_list) {
1.984     raeburn  8971:         my ($file_name,$rest)=split(/\&/,$line,2);
1.661     raeburn  8972:         if ($file_name eq $fname){
                   8973:             $file_name = $path.$file_name;
                   8974:             if ($group ne '') {
                   8975:                 $file_name = $group.$file_name;
                   8976:             }
                   8977:             $found_file = 1;
1.991     raeburn  8978:             if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   8979:                 foreach my $lock (@lockers) {
                   8980:                     if (ref($lock) eq 'ARRAY') {
                   8981:                         my ($symb,$crsid) = @{$lock};
                   8982:                         if ($crsid eq $env{'request.course.id'}) {
                   8983:                             if (ref($navmap)) {
                   8984:                                 my $res = $navmap->getBySymb($symb);
                   8985:                                 foreach my $part (@{$res->parts()}) { 
                   8986:                                     my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   8987:                                     unless (($slot_status == $res->RESERVED) ||
                   8988:                                             ($slot_status == $res->RESERVED_LOCATION)) {
                   8989:                                         $locked_file = 1;
                   8990:                                     }
                   8991:                                 }
                   8992:                             } else {
                   8993:                                 $locked_file = 1;
                   8994:                             }
                   8995:                         } else {
                   8996:                             $locked_file = 1;
                   8997:                         }
                   8998:                     }
                   8999:                 }
1.984     raeburn  9000:             } else {
                   9001:                 my @info = split(/\&/,$rest);
                   9002:                 my $currsize = $info[6]/1000;
                   9003:                 if ($currsize < $filesize) {
                   9004:                     my $extra = $filesize - $currsize;
                   9005:                     if (($current_disk_usage + $extra) > $disk_quota) {
                   9006:                         my $msg = '<span class="LC_error">'.
                   9007:                                   &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.',
                   9008:                                       '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                   9009:                                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   9010:                                                $disk_quota,$current_disk_usage);
                   9011:                         return ('will_exceed_quota',$msg);
                   9012:                     }
                   9013:                 }
1.661     raeburn  9014:             }
                   9015:         }
                   9016:     }
                   9017:     if (($current_disk_usage + $filesize) > $disk_quota){
                   9018:         my $msg = '<span class="LC_error">'.
                   9019:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   9020:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   9021:         return ('will_exceed_quota',$msg);
                   9022:     } elsif ($found_file) {
                   9023:         if ($locked_file) {
                   9024:             my $msg = '<span class="LC_error">';
                   9025:             $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>');
                   9026:             $msg .= '</span><br />';
                   9027:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   9028:             return ('file_locked',$msg);
                   9029:         } else {
                   9030:             my $msg = '<span class="LC_error">';
1.984     raeburn  9031:             $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  9032:             $msg .= '</span>';
1.984     raeburn  9033:             return ('existingfile',$msg);
1.661     raeburn  9034:         }
                   9035:     }
                   9036: }
                   9037: 
1.987     raeburn  9038: sub check_for_traversal {
                   9039:     my ($path,$url,$toplevel) = @_;
                   9040:     my @parts=split(/\//,$path);
                   9041:     my $cleanpath;
                   9042:     my $fullpath = $url;
                   9043:     for (my $i=0;$i<@parts;$i++) {
                   9044:         next if ($parts[$i] eq '.');
                   9045:         if ($parts[$i] eq '..') {
                   9046:             $fullpath =~ s{([^/]+/)$}{};
                   9047:         } else {
                   9048:             $fullpath .= $parts[$i].'/';
                   9049:         }
                   9050:     }
                   9051:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   9052:         $cleanpath = $1;
                   9053:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   9054:         my $curr_toprel = $1;
                   9055:         my @parts = split(/\//,$curr_toprel);
                   9056:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   9057:         my @urlparts = split(/\//,$url_toprel);
                   9058:         my $doubledots;
                   9059:         my $startdiff = -1;
                   9060:         for (my $i=0; $i<@urlparts; $i++) {
                   9061:             if ($startdiff == -1) {
                   9062:                 unless ($urlparts[$i] eq $parts[$i]) {
                   9063:                     $startdiff = $i;
                   9064:                     $doubledots .= '../';
                   9065:                 }
                   9066:             } else {
                   9067:                 $doubledots .= '../';
                   9068:             }
                   9069:         }
                   9070:         if ($startdiff > -1) {
                   9071:             $cleanpath = $doubledots;
                   9072:             for (my $i=$startdiff; $i<@parts; $i++) {
                   9073:                 $cleanpath .= $parts[$i].'/';
                   9074:             }
                   9075:         }
                   9076:     }
                   9077:     $cleanpath =~ s{(/)$}{};
                   9078:     return $cleanpath;
                   9079: }
1.31      albertel 9080: 
1.41      ng       9081: =pod
1.45      matthew  9082: 
1.464     albertel 9083: =back
1.41      ng       9084: 
1.112     bowersj2 9085: =head1 CSV Upload/Handling functions
1.38      albertel 9086: 
1.41      ng       9087: =over 4
                   9088: 
1.648     raeburn  9089: =item * &upfile_store($r)
1.41      ng       9090: 
                   9091: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 9092: needs $env{'form.upfile'}
1.41      ng       9093: returns $datatoken to be put into hidden field
                   9094: 
                   9095: =cut
1.31      albertel 9096: 
                   9097: sub upfile_store {
                   9098:     my $r=shift;
1.258     albertel 9099:     $env{'form.upfile'}=~s/\r/\n/gs;
                   9100:     $env{'form.upfile'}=~s/\f/\n/gs;
                   9101:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   9102:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 9103: 
1.258     albertel 9104:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   9105: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 9106:     {
1.158     raeburn  9107:         my $datafile = $r->dir_config('lonDaemons').
                   9108:                            '/tmp/'.$datatoken.'.tmp';
                   9109:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 9110:             print $fh $env{'form.upfile'};
1.158     raeburn  9111:             close($fh);
                   9112:         }
1.31      albertel 9113:     }
                   9114:     return $datatoken;
                   9115: }
                   9116: 
1.56      matthew  9117: =pod
                   9118: 
1.648     raeburn  9119: =item * &load_tmp_file($r)
1.41      ng       9120: 
                   9121: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 9122: needs $env{'form.datatoken'},
                   9123: sets $env{'form.upfile'} to the contents of the file
1.41      ng       9124: 
                   9125: =cut
1.31      albertel 9126: 
                   9127: sub load_tmp_file {
                   9128:     my $r=shift;
                   9129:     my @studentdata=();
                   9130:     {
1.158     raeburn  9131:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 9132:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  9133:         if ( open(my $fh,"<$studentfile") ) {
                   9134:             @studentdata=<$fh>;
                   9135:             close($fh);
                   9136:         }
1.31      albertel 9137:     }
1.258     albertel 9138:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 9139: }
                   9140: 
1.56      matthew  9141: =pod
                   9142: 
1.648     raeburn  9143: =item * &upfile_record_sep()
1.41      ng       9144: 
                   9145: Separate uploaded file into records
                   9146: returns array of records,
1.258     albertel 9147: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       9148: 
                   9149: =cut
1.31      albertel 9150: 
                   9151: sub upfile_record_sep {
1.258     albertel 9152:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 9153:     } else {
1.248     albertel 9154: 	my @records;
1.258     albertel 9155: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 9156: 	    if ($line=~/^\s*$/) { next; }
                   9157: 	    push(@records,$line);
                   9158: 	}
                   9159: 	return @records;
1.31      albertel 9160:     }
                   9161: }
                   9162: 
1.56      matthew  9163: =pod
                   9164: 
1.648     raeburn  9165: =item * &record_sep($record)
1.41      ng       9166: 
1.258     albertel 9167: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       9168: 
                   9169: =cut
                   9170: 
1.263     www      9171: sub takeleft {
                   9172:     my $index=shift;
                   9173:     return substr('0000'.$index,-4,4);
                   9174: }
                   9175: 
1.31      albertel 9176: sub record_sep {
                   9177:     my $record=shift;
                   9178:     my %components=();
1.258     albertel 9179:     if ($env{'form.upfiletype'} eq 'xml') {
                   9180:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 9181:         my $i=0;
1.356     albertel 9182:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 9183:             $field=~s/^(\"|\')//;
                   9184:             $field=~s/(\"|\')$//;
1.263     www      9185:             $components{&takeleft($i)}=$field;
1.31      albertel 9186:             $i++;
                   9187:         }
1.258     albertel 9188:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 9189:         my $i=0;
1.356     albertel 9190:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 9191:             $field=~s/^(\"|\')//;
                   9192:             $field=~s/(\"|\')$//;
1.263     www      9193:             $components{&takeleft($i)}=$field;
1.31      albertel 9194:             $i++;
                   9195:         }
                   9196:     } else {
1.561     www      9197:         my $separator=',';
1.480     banghart 9198:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      9199:             $separator=';';
1.480     banghart 9200:         }
1.31      albertel 9201:         my $i=0;
1.561     www      9202: # the character we are looking for to indicate the end of a quote or a record 
                   9203:         my $looking_for=$separator;
                   9204: # do not add the characters to the fields
                   9205:         my $ignore=0;
                   9206: # we just encountered a separator (or the beginning of the record)
                   9207:         my $just_found_separator=1;
                   9208: # store the field we are working on here
                   9209:         my $field='';
                   9210: # work our way through all characters in record
                   9211:         foreach my $character ($record=~/(.)/g) {
                   9212:             if ($character eq $looking_for) {
                   9213:                if ($character ne $separator) {
                   9214: # Found the end of a quote, again looking for separator
                   9215:                   $looking_for=$separator;
                   9216:                   $ignore=1;
                   9217:                } else {
                   9218: # Found a separator, store away what we got
                   9219:                   $components{&takeleft($i)}=$field;
                   9220: 	          $i++;
                   9221:                   $just_found_separator=1;
                   9222:                   $ignore=0;
                   9223:                   $field='';
                   9224:                }
                   9225:                next;
                   9226:             }
                   9227: # single or double quotation marks after a separator indicate beginning of a quote
                   9228: # we are now looking for the end of the quote and need to ignore separators
                   9229:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   9230:                $looking_for=$character;
                   9231:                next;
                   9232:             }
                   9233: # ignore would be true after we reached the end of a quote
                   9234:             if ($ignore) { next; }
                   9235:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   9236:             $field.=$character;
                   9237:             $just_found_separator=0; 
1.31      albertel 9238:         }
1.561     www      9239: # catch the very last entry, since we never encountered the separator
                   9240:         $components{&takeleft($i)}=$field;
1.31      albertel 9241:     }
                   9242:     return %components;
                   9243: }
                   9244: 
1.144     matthew  9245: ######################################################
                   9246: ######################################################
                   9247: 
1.56      matthew  9248: =pod
                   9249: 
1.648     raeburn  9250: =item * &upfile_select_html()
1.41      ng       9251: 
1.144     matthew  9252: Return HTML code to select a file from the users machine and specify 
                   9253: the file type.
1.41      ng       9254: 
                   9255: =cut
                   9256: 
1.144     matthew  9257: ######################################################
                   9258: ######################################################
1.31      albertel 9259: sub upfile_select_html {
1.144     matthew  9260:     my %Types = (
                   9261:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 9262:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  9263:                  space => &mt('Space separated'),
                   9264:                  tab   => &mt('Tabulator separated'),
                   9265: #                 xml   => &mt('HTML/XML'),
                   9266:                  );
                   9267:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  9268:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  9269:     foreach my $type (sort(keys(%Types))) {
                   9270:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   9271:     }
                   9272:     $Str .= "</select>\n";
                   9273:     return $Str;
1.31      albertel 9274: }
                   9275: 
1.301     albertel 9276: sub get_samples {
                   9277:     my ($records,$toget) = @_;
                   9278:     my @samples=({});
                   9279:     my $got=0;
                   9280:     foreach my $rec (@$records) {
                   9281: 	my %temp = &record_sep($rec);
                   9282: 	if (! grep(/\S/, values(%temp))) { next; }
                   9283: 	if (%temp) {
                   9284: 	    $samples[$got]=\%temp;
                   9285: 	    $got++;
                   9286: 	    if ($got == $toget) { last; }
                   9287: 	}
                   9288:     }
                   9289:     return \@samples;
                   9290: }
                   9291: 
1.144     matthew  9292: ######################################################
                   9293: ######################################################
                   9294: 
1.56      matthew  9295: =pod
                   9296: 
1.648     raeburn  9297: =item * &csv_print_samples($r,$records)
1.41      ng       9298: 
                   9299: Prints a table of sample values from each column uploaded $r is an
                   9300: Apache Request ref, $records is an arrayref from
                   9301: &Apache::loncommon::upfile_record_sep
                   9302: 
                   9303: =cut
                   9304: 
1.144     matthew  9305: ######################################################
                   9306: ######################################################
1.31      albertel 9307: sub csv_print_samples {
                   9308:     my ($r,$records) = @_;
1.662     bisitz   9309:     my $samples = &get_samples($records,5);
1.301     albertel 9310: 
1.594     raeburn  9311:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   9312:               &start_data_table_header_row());
1.356     albertel 9313:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   9314:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  9315:     $r->print(&end_data_table_header_row());
1.301     albertel 9316:     foreach my $hash (@$samples) {
1.594     raeburn  9317: 	$r->print(&start_data_table_row());
1.356     albertel 9318: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 9319: 	    $r->print('<td>');
1.356     albertel 9320: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 9321: 	    $r->print('</td>');
                   9322: 	}
1.594     raeburn  9323: 	$r->print(&end_data_table_row());
1.31      albertel 9324:     }
1.594     raeburn  9325:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 9326: }
                   9327: 
1.144     matthew  9328: ######################################################
                   9329: ######################################################
                   9330: 
1.56      matthew  9331: =pod
                   9332: 
1.648     raeburn  9333: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       9334: 
                   9335: Prints a table to create associations between values and table columns.
1.144     matthew  9336: 
1.41      ng       9337: $r is an Apache Request ref,
                   9338: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  9339: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       9340: 
                   9341: =cut
                   9342: 
1.144     matthew  9343: ######################################################
                   9344: ######################################################
1.31      albertel 9345: sub csv_print_select_table {
                   9346:     my ($r,$records,$d) = @_;
1.301     albertel 9347:     my $i=0;
                   9348:     my $samples = &get_samples($records,1);
1.144     matthew  9349:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  9350: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  9351:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  9352:               '<th>'.&mt('Column').'</th>'.
                   9353:               &end_data_table_header_row()."\n");
1.356     albertel 9354:     foreach my $array_ref (@$d) {
                   9355: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  9356: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 9357: 
1.875     bisitz   9358: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  9359: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 9360: 	$r->print('<option value="none"></option>');
1.356     albertel 9361: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   9362: 	    $r->print('<option value="'.$sample.'"'.
                   9363:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   9364:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 9365: 	}
1.594     raeburn  9366: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 9367: 	$i++;
                   9368:     }
1.594     raeburn  9369:     $r->print(&end_data_table());
1.31      albertel 9370:     $i--;
                   9371:     return $i;
                   9372: }
1.56      matthew  9373: 
1.144     matthew  9374: ######################################################
                   9375: ######################################################
                   9376: 
1.56      matthew  9377: =pod
1.31      albertel 9378: 
1.648     raeburn  9379: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       9380: 
                   9381: Prints a table of sample values from the upload and can make associate samples to internal names.
                   9382: 
                   9383: $r is an Apache Request ref,
                   9384: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   9385: $d is an array of 2 element arrays (internal name, displayed name)
                   9386: 
                   9387: =cut
                   9388: 
1.144     matthew  9389: ######################################################
                   9390: ######################################################
1.31      albertel 9391: sub csv_samples_select_table {
                   9392:     my ($r,$records,$d) = @_;
                   9393:     my $i=0;
1.144     matthew  9394:     #
1.662     bisitz   9395:     my $max_samples = 5;
                   9396:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  9397:     $r->print(&start_data_table().
                   9398:               &start_data_table_header_row().'<th>'.
                   9399:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   9400:               &end_data_table_header_row());
1.301     albertel 9401: 
                   9402:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  9403: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  9404: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 9405: 	foreach my $option (@$d) {
                   9406: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  9407: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 9408:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  9409:                       $display.'</option>');
1.31      albertel 9410: 	}
                   9411: 	$r->print('</select></td><td>');
1.662     bisitz   9412: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 9413: 	    if (defined($samples->[$line]{$key})) { 
                   9414: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   9415: 	    }
                   9416: 	}
1.594     raeburn  9417: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 9418: 	$i++;
                   9419:     }
1.594     raeburn  9420:     $r->print(&end_data_table());
1.31      albertel 9421:     $i--;
                   9422:     return($i);
1.115     matthew  9423: }
                   9424: 
1.144     matthew  9425: ######################################################
                   9426: ######################################################
                   9427: 
1.115     matthew  9428: =pod
                   9429: 
1.648     raeburn  9430: =item * &clean_excel_name($name)
1.115     matthew  9431: 
                   9432: Returns a replacement for $name which does not contain any illegal characters.
                   9433: 
                   9434: =cut
                   9435: 
1.144     matthew  9436: ######################################################
                   9437: ######################################################
1.115     matthew  9438: sub clean_excel_name {
                   9439:     my ($name) = @_;
                   9440:     $name =~ s/[:\*\?\/\\]//g;
                   9441:     if (length($name) > 31) {
                   9442:         $name = substr($name,0,31);
                   9443:     }
                   9444:     return $name;
1.25      albertel 9445: }
1.84      albertel 9446: 
1.85      albertel 9447: =pod
                   9448: 
1.648     raeburn  9449: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 9450: 
                   9451: Returns either 1 or undef
                   9452: 
                   9453: 1 if the part is to be hidden, undef if it is to be shown
                   9454: 
                   9455: Arguments are:
                   9456: 
                   9457: $id the id of the part to be checked
                   9458: $symb, optional the symb of the resource to check
                   9459: $udom, optional the domain of the user to check for
                   9460: $uname, optional the username of the user to check for
                   9461: 
                   9462: =cut
1.84      albertel 9463: 
                   9464: sub check_if_partid_hidden {
                   9465:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 9466:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 9467: 					 $symb,$udom,$uname);
1.141     albertel 9468:     my $truth=1;
                   9469:     #if the string starts with !, then the list is the list to show not hide
                   9470:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 9471:     my @hiddenlist=split(/,/,$hiddenparts);
                   9472:     foreach my $checkid (@hiddenlist) {
1.141     albertel 9473: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 9474:     }
1.141     albertel 9475:     return !$truth;
1.84      albertel 9476: }
1.127     matthew  9477: 
1.138     matthew  9478: 
                   9479: ############################################################
                   9480: ############################################################
                   9481: 
                   9482: =pod
                   9483: 
1.157     matthew  9484: =back 
                   9485: 
1.138     matthew  9486: =head1 cgi-bin script and graphing routines
                   9487: 
1.157     matthew  9488: =over 4
                   9489: 
1.648     raeburn  9490: =item * &get_cgi_id()
1.138     matthew  9491: 
                   9492: Inputs: none
                   9493: 
                   9494: Returns an id which can be used to pass environment variables
                   9495: to various cgi-bin scripts.  These environment variables will
                   9496: be removed from the users environment after a given time by
                   9497: the routine &Apache::lonnet::transfer_profile_to_env.
                   9498: 
                   9499: =cut
                   9500: 
                   9501: ############################################################
                   9502: ############################################################
1.152     albertel 9503: my $uniq=0;
1.136     matthew  9504: sub get_cgi_id {
1.154     albertel 9505:     $uniq=($uniq+1)%100000;
1.280     albertel 9506:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  9507: }
                   9508: 
1.127     matthew  9509: ############################################################
                   9510: ############################################################
                   9511: 
                   9512: =pod
                   9513: 
1.648     raeburn  9514: =item * &DrawBarGraph()
1.127     matthew  9515: 
1.138     matthew  9516: Facilitates the plotting of data in a (stacked) bar graph.
                   9517: Puts plot definition data into the users environment in order for 
                   9518: graph.png to plot it.  Returns an <img> tag for the plot.
                   9519: The bars on the plot are labeled '1','2',...,'n'.
                   9520: 
                   9521: Inputs:
                   9522: 
                   9523: =over 4
                   9524: 
                   9525: =item $Title: string, the title of the plot
                   9526: 
                   9527: =item $xlabel: string, text describing the X-axis of the plot
                   9528: 
                   9529: =item $ylabel: string, text describing the Y-axis of the plot
                   9530: 
                   9531: =item $Max: scalar, the maximum Y value to use in the plot
                   9532: If $Max is < any data point, the graph will not be rendered.
                   9533: 
1.140     matthew  9534: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  9535: they are plotted.  If undefined, default values will be used.
                   9536: 
1.178     matthew  9537: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   9538: 
1.138     matthew  9539: =item @Values: An array of array references.  Each array reference holds data
                   9540: to be plotted in a stacked bar chart.
                   9541: 
1.239     matthew  9542: =item If the final element of @Values is a hash reference the key/value
                   9543: pairs will be added to the graph definition.
                   9544: 
1.138     matthew  9545: =back
                   9546: 
                   9547: Returns:
                   9548: 
                   9549: An <img> tag which references graph.png and the appropriate identifying
                   9550: information for the plot.
                   9551: 
1.127     matthew  9552: =cut
                   9553: 
                   9554: ############################################################
                   9555: ############################################################
1.134     matthew  9556: sub DrawBarGraph {
1.178     matthew  9557:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  9558:     #
                   9559:     if (! defined($colors)) {
                   9560:         $colors = ['#33ff00', 
                   9561:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   9562:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   9563:                   ]; 
                   9564:     }
1.228     matthew  9565:     my $extra_settings = {};
                   9566:     if (ref($Values[-1]) eq 'HASH') {
                   9567:         $extra_settings = pop(@Values);
                   9568:     }
1.127     matthew  9569:     #
1.136     matthew  9570:     my $identifier = &get_cgi_id();
                   9571:     my $id = 'cgi.'.$identifier;        
1.129     matthew  9572:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  9573:         return '';
                   9574:     }
1.225     matthew  9575:     #
                   9576:     my @Labels;
                   9577:     if (defined($labels)) {
                   9578:         @Labels = @$labels;
                   9579:     } else {
                   9580:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   9581:             push (@Labels,$i+1);
                   9582:         }
                   9583:     }
                   9584:     #
1.129     matthew  9585:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  9586:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  9587:     my %ValuesHash;
                   9588:     my $NumSets=1;
                   9589:     foreach my $array (@Values) {
                   9590:         next if (! ref($array));
1.136     matthew  9591:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  9592:             join(',',@$array);
1.129     matthew  9593:     }
1.127     matthew  9594:     #
1.136     matthew  9595:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  9596:     if ($NumBars < 3) {
                   9597:         $width = 120+$NumBars*32;
1.220     matthew  9598:         $xskip = 1;
1.225     matthew  9599:         $bar_width = 30;
                   9600:     } elsif ($NumBars < 5) {
                   9601:         $width = 120+$NumBars*20;
                   9602:         $xskip = 1;
                   9603:         $bar_width = 20;
1.220     matthew  9604:     } elsif ($NumBars < 10) {
1.136     matthew  9605:         $width = 120+$NumBars*15;
                   9606:         $xskip = 1;
                   9607:         $bar_width = 15;
                   9608:     } elsif ($NumBars <= 25) {
                   9609:         $width = 120+$NumBars*11;
                   9610:         $xskip = 5;
                   9611:         $bar_width = 8;
                   9612:     } elsif ($NumBars <= 50) {
                   9613:         $width = 120+$NumBars*8;
                   9614:         $xskip = 5;
                   9615:         $bar_width = 4;
                   9616:     } else {
                   9617:         $width = 120+$NumBars*8;
                   9618:         $xskip = 5;
                   9619:         $bar_width = 4;
                   9620:     }
                   9621:     #
1.137     matthew  9622:     $Max = 1 if ($Max < 1);
                   9623:     if ( int($Max) < $Max ) {
                   9624:         $Max++;
                   9625:         $Max = int($Max);
                   9626:     }
1.127     matthew  9627:     $Title  = '' if (! defined($Title));
                   9628:     $xlabel = '' if (! defined($xlabel));
                   9629:     $ylabel = '' if (! defined($ylabel));
1.369     www      9630:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   9631:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   9632:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  9633:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  9634:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   9635:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   9636:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   9637:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   9638:     $ValuesHash{$id.'.height'}   = $height;
                   9639:     $ValuesHash{$id.'.width'}    = $width;
                   9640:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   9641:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   9642:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  9643:     #
1.228     matthew  9644:     # Deal with other parameters
                   9645:     while (my ($key,$value) = each(%$extra_settings)) {
                   9646:         $ValuesHash{$id.'.'.$key} = $value;
                   9647:     }
                   9648:     #
1.646     raeburn  9649:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  9650:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   9651: }
                   9652: 
                   9653: ############################################################
                   9654: ############################################################
                   9655: 
                   9656: =pod
                   9657: 
1.648     raeburn  9658: =item * &DrawXYGraph()
1.137     matthew  9659: 
1.138     matthew  9660: Facilitates the plotting of data in an XY graph.
                   9661: Puts plot definition data into the users environment in order for 
                   9662: graph.png to plot it.  Returns an <img> tag for the plot.
                   9663: 
                   9664: Inputs:
                   9665: 
                   9666: =over 4
                   9667: 
                   9668: =item $Title: string, the title of the plot
                   9669: 
                   9670: =item $xlabel: string, text describing the X-axis of the plot
                   9671: 
                   9672: =item $ylabel: string, text describing the Y-axis of the plot
                   9673: 
                   9674: =item $Max: scalar, the maximum Y value to use in the plot
                   9675: If $Max is < any data point, the graph will not be rendered.
                   9676: 
                   9677: =item $colors: Array ref containing the hex color codes for the data to be 
                   9678: plotted in.  If undefined, default values will be used.
                   9679: 
                   9680: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   9681: 
                   9682: =item $Ydata: Array ref containing Array refs.  
1.185     www      9683: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  9684: 
                   9685: =item %Values: hash indicating or overriding any default values which are 
                   9686: passed to graph.png.  
                   9687: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   9688: 
                   9689: =back
                   9690: 
                   9691: Returns:
                   9692: 
                   9693: An <img> tag which references graph.png and the appropriate identifying
                   9694: information for the plot.
                   9695: 
1.137     matthew  9696: =cut
                   9697: 
                   9698: ############################################################
                   9699: ############################################################
                   9700: sub DrawXYGraph {
                   9701:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   9702:     #
                   9703:     # Create the identifier for the graph
                   9704:     my $identifier = &get_cgi_id();
                   9705:     my $id = 'cgi.'.$identifier;
                   9706:     #
                   9707:     $Title  = '' if (! defined($Title));
                   9708:     $xlabel = '' if (! defined($xlabel));
                   9709:     $ylabel = '' if (! defined($ylabel));
                   9710:     my %ValuesHash = 
                   9711:         (
1.369     www      9712:          $id.'.title'  => &escape($Title),
                   9713:          $id.'.xlabel' => &escape($xlabel),
                   9714:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  9715:          $id.'.y_max_value'=> $Max,
                   9716:          $id.'.labels'     => join(',',@$Xlabels),
                   9717:          $id.'.PlotType'   => 'XY',
                   9718:          );
                   9719:     #
                   9720:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   9721:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   9722:     }
                   9723:     #
                   9724:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   9725:         return '';
                   9726:     }
                   9727:     my $NumSets=1;
1.138     matthew  9728:     foreach my $array (@{$Ydata}){
1.137     matthew  9729:         next if (! ref($array));
                   9730:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   9731:     }
1.138     matthew  9732:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  9733:     #
                   9734:     # Deal with other parameters
                   9735:     while (my ($key,$value) = each(%Values)) {
                   9736:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  9737:     }
                   9738:     #
1.646     raeburn  9739:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  9740:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   9741: }
                   9742: 
                   9743: ############################################################
                   9744: ############################################################
                   9745: 
                   9746: =pod
                   9747: 
1.648     raeburn  9748: =item * &DrawXYYGraph()
1.138     matthew  9749: 
                   9750: Facilitates the plotting of data in an XY graph with two Y axes.
                   9751: Puts plot definition data into the users environment in order for 
                   9752: graph.png to plot it.  Returns an <img> tag for the plot.
                   9753: 
                   9754: Inputs:
                   9755: 
                   9756: =over 4
                   9757: 
                   9758: =item $Title: string, the title of the plot
                   9759: 
                   9760: =item $xlabel: string, text describing the X-axis of the plot
                   9761: 
                   9762: =item $ylabel: string, text describing the Y-axis of the plot
                   9763: 
                   9764: =item $colors: Array ref containing the hex color codes for the data to be 
                   9765: plotted in.  If undefined, default values will be used.
                   9766: 
                   9767: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   9768: 
                   9769: =item $Ydata1: The first data set
                   9770: 
                   9771: =item $Min1: The minimum value of the left Y-axis
                   9772: 
                   9773: =item $Max1: The maximum value of the left Y-axis
                   9774: 
                   9775: =item $Ydata2: The second data set
                   9776: 
                   9777: =item $Min2: The minimum value of the right Y-axis
                   9778: 
                   9779: =item $Max2: The maximum value of the left Y-axis
                   9780: 
                   9781: =item %Values: hash indicating or overriding any default values which are 
                   9782: passed to graph.png.  
                   9783: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   9784: 
                   9785: =back
                   9786: 
                   9787: Returns:
                   9788: 
                   9789: An <img> tag which references graph.png and the appropriate identifying
                   9790: information for the plot.
1.136     matthew  9791: 
                   9792: =cut
                   9793: 
                   9794: ############################################################
                   9795: ############################################################
1.137     matthew  9796: sub DrawXYYGraph {
                   9797:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   9798:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  9799:     #
                   9800:     # Create the identifier for the graph
                   9801:     my $identifier = &get_cgi_id();
                   9802:     my $id = 'cgi.'.$identifier;
                   9803:     #
                   9804:     $Title  = '' if (! defined($Title));
                   9805:     $xlabel = '' if (! defined($xlabel));
                   9806:     $ylabel = '' if (! defined($ylabel));
                   9807:     my %ValuesHash = 
                   9808:         (
1.369     www      9809:          $id.'.title'  => &escape($Title),
                   9810:          $id.'.xlabel' => &escape($xlabel),
                   9811:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  9812:          $id.'.labels' => join(',',@$Xlabels),
                   9813:          $id.'.PlotType' => 'XY',
                   9814:          $id.'.NumSets' => 2,
1.137     matthew  9815:          $id.'.two_axes' => 1,
                   9816:          $id.'.y1_max_value' => $Max1,
                   9817:          $id.'.y1_min_value' => $Min1,
                   9818:          $id.'.y2_max_value' => $Max2,
                   9819:          $id.'.y2_min_value' => $Min2,
1.136     matthew  9820:          );
                   9821:     #
1.137     matthew  9822:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   9823:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   9824:     }
                   9825:     #
                   9826:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   9827:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  9828:         return '';
                   9829:     }
                   9830:     my $NumSets=1;
1.137     matthew  9831:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  9832:         next if (! ref($array));
                   9833:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  9834:     }
                   9835:     #
                   9836:     # Deal with other parameters
                   9837:     while (my ($key,$value) = each(%Values)) {
                   9838:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  9839:     }
                   9840:     #
1.646     raeburn  9841:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 9842:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  9843: }
                   9844: 
                   9845: ############################################################
                   9846: ############################################################
                   9847: 
                   9848: =pod
                   9849: 
1.157     matthew  9850: =back 
                   9851: 
1.139     matthew  9852: =head1 Statistics helper routines?  
                   9853: 
                   9854: Bad place for them but what the hell.
                   9855: 
1.157     matthew  9856: =over 4
                   9857: 
1.648     raeburn  9858: =item * &chartlink()
1.139     matthew  9859: 
                   9860: Returns a link to the chart for a specific student.  
                   9861: 
                   9862: Inputs:
                   9863: 
                   9864: =over 4
                   9865: 
                   9866: =item $linktext: The text of the link
                   9867: 
                   9868: =item $sname: The students username
                   9869: 
                   9870: =item $sdomain: The students domain
                   9871: 
                   9872: =back
                   9873: 
1.157     matthew  9874: =back
                   9875: 
1.139     matthew  9876: =cut
                   9877: 
                   9878: ############################################################
                   9879: ############################################################
                   9880: sub chartlink {
                   9881:     my ($linktext, $sname, $sdomain) = @_;
                   9882:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      9883:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 9884:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  9885:        '">'.$linktext.'</a>';
1.153     matthew  9886: }
                   9887: 
                   9888: #######################################################
                   9889: #######################################################
                   9890: 
                   9891: =pod
                   9892: 
                   9893: =head1 Course Environment Routines
1.157     matthew  9894: 
                   9895: =over 4
1.153     matthew  9896: 
1.648     raeburn  9897: =item * &restore_course_settings()
1.153     matthew  9898: 
1.648     raeburn  9899: =item * &store_course_settings()
1.153     matthew  9900: 
                   9901: Restores/Store indicated form parameters from the course environment.
                   9902: Will not overwrite existing values of the form parameters.
                   9903: 
                   9904: Inputs: 
                   9905: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   9906: 
                   9907: a hash ref describing the data to be stored.  For example:
                   9908:    
                   9909: %Save_Parameters = ('Status' => 'scalar',
                   9910:     'chartoutputmode' => 'scalar',
                   9911:     'chartoutputdata' => 'scalar',
                   9912:     'Section' => 'array',
1.373     raeburn  9913:     'Group' => 'array',
1.153     matthew  9914:     'StudentData' => 'array',
                   9915:     'Maps' => 'array');
                   9916: 
                   9917: Returns: both routines return nothing
                   9918: 
1.631     raeburn  9919: =back
                   9920: 
1.153     matthew  9921: =cut
                   9922: 
                   9923: #######################################################
                   9924: #######################################################
                   9925: sub store_course_settings {
1.496     albertel 9926:     return &store_settings($env{'request.course.id'},@_);
                   9927: }
                   9928: 
                   9929: sub store_settings {
1.153     matthew  9930:     # save to the environment
                   9931:     # appenv the same items, just to be safe
1.300     albertel 9932:     my $udom  = $env{'user.domain'};
                   9933:     my $uname = $env{'user.name'};
1.496     albertel 9934:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  9935:     my %SaveHash;
                   9936:     my %AppHash;
                   9937:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 9938:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 9939:         my $envname = 'environment.'.$basename;
1.258     albertel 9940:         if (exists($env{'form.'.$setting})) {
1.153     matthew  9941:             # Save this value away
                   9942:             if ($type eq 'scalar' &&
1.258     albertel 9943:                 (! exists($env{$envname}) || 
                   9944:                  $env{$envname} ne $env{'form.'.$setting})) {
                   9945:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   9946:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  9947:             } elsif ($type eq 'array') {
                   9948:                 my $stored_form;
1.258     albertel 9949:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  9950:                     $stored_form = join(',',
                   9951:                                         map {
1.369     www      9952:                                             &escape($_);
1.258     albertel 9953:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  9954:                 } else {
                   9955:                     $stored_form = 
1.369     www      9956:                         &escape($env{'form.'.$setting});
1.153     matthew  9957:                 }
                   9958:                 # Determine if the array contents are the same.
1.258     albertel 9959:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  9960:                     $SaveHash{$basename} = $stored_form;
                   9961:                     $AppHash{$envname}   = $stored_form;
                   9962:                 }
                   9963:             }
                   9964:         }
                   9965:     }
                   9966:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 9967:                                           $udom,$uname);
1.153     matthew  9968:     if ($put_result !~ /^(ok|delayed)/) {
                   9969:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   9970:                                  'got error:'.$put_result);
                   9971:     }
                   9972:     # Make sure these settings stick around in this session, too
1.646     raeburn  9973:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  9974:     return;
                   9975: }
                   9976: 
                   9977: sub restore_course_settings {
1.499     albertel 9978:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 9979: }
                   9980: 
                   9981: sub restore_settings {
                   9982:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  9983:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 9984:         next if (exists($env{'form.'.$setting}));
1.496     albertel 9985:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  9986:             '.'.$setting;
1.258     albertel 9987:         if (exists($env{$envname})) {
1.153     matthew  9988:             if ($type eq 'scalar') {
1.258     albertel 9989:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  9990:             } elsif ($type eq 'array') {
1.258     albertel 9991:                 $env{'form.'.$setting} = [ 
1.153     matthew  9992:                                            map { 
1.369     www      9993:                                                &unescape($_); 
1.258     albertel 9994:                                            } split(',',$env{$envname})
1.153     matthew  9995:                                            ];
                   9996:             }
                   9997:         }
                   9998:     }
1.127     matthew  9999: }
                   10000: 
1.618     raeburn  10001: #######################################################
                   10002: #######################################################
                   10003: 
                   10004: =pod
                   10005: 
                   10006: =head1 Domain E-mail Routines  
                   10007: 
                   10008: =over 4
                   10009: 
1.648     raeburn  10010: =item * &build_recipient_list()
1.618     raeburn  10011: 
1.884     raeburn  10012: Build recipient lists for five types of e-mail:
1.766     raeburn  10013: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884     raeburn  10014: (d) Help requests, (e) Course requests needing approval,  generated by
                   10015: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
                   10016: loncoursequeueadmin.pm respectively.
1.618     raeburn  10017: 
                   10018: Inputs:
1.619     raeburn  10019: defmail (scalar - email address of default recipient), 
1.618     raeburn  10020: mailing type (scalar - errormail, packagesmail, or helpdeskmail), 
1.619     raeburn  10021: defdom (domain for which to retrieve configuration settings),
                   10022: origmail (scalar - email address of recipient from loncapa.conf, 
                   10023: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  10024: 
1.655     raeburn  10025: Returns: comma separated list of addresses to which to send e-mail.
                   10026: 
                   10027: =back
1.618     raeburn  10028: 
                   10029: =cut
                   10030: 
                   10031: ############################################################
                   10032: ############################################################
                   10033: sub build_recipient_list {
1.619     raeburn  10034:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  10035:     my @recipients;
                   10036:     my $otheremails;
                   10037:     my %domconfig =
                   10038:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   10039:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  10040:         if (exists($domconfig{'contacts'}{$mailing})) {
                   10041:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   10042:                 my @contacts = ('adminemail','supportemail');
                   10043:                 foreach my $item (@contacts) {
                   10044:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   10045:                         my $addr = $domconfig{'contacts'}{$item}; 
                   10046:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   10047:                             push(@recipients,$addr);
                   10048:                         }
1.619     raeburn  10049:                     }
1.766     raeburn  10050:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  10051:                 }
                   10052:             }
1.766     raeburn  10053:         } elsif ($origmail ne '') {
                   10054:             push(@recipients,$origmail);
1.618     raeburn  10055:         }
1.619     raeburn  10056:     } elsif ($origmail ne '') {
                   10057:         push(@recipients,$origmail);
1.618     raeburn  10058:     }
1.688     raeburn  10059:     if (defined($defmail)) {
                   10060:         if ($defmail ne '') {
                   10061:             push(@recipients,$defmail);
                   10062:         }
1.618     raeburn  10063:     }
                   10064:     if ($otheremails) {
1.619     raeburn  10065:         my @others;
                   10066:         if ($otheremails =~ /,/) {
                   10067:             @others = split(/,/,$otheremails);
1.618     raeburn  10068:         } else {
1.619     raeburn  10069:             push(@others,$otheremails);
                   10070:         }
                   10071:         foreach my $addr (@others) {
                   10072:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   10073:                 push(@recipients,$addr);
                   10074:             }
1.618     raeburn  10075:         }
                   10076:     }
1.619     raeburn  10077:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  10078:     return $recipientlist;
                   10079: }
                   10080: 
1.127     matthew  10081: ############################################################
                   10082: ############################################################
1.154     albertel 10083: 
1.655     raeburn  10084: =pod
                   10085: 
                   10086: =head1 Course Catalog Routines
                   10087: 
                   10088: =over 4
                   10089: 
                   10090: =item * &gather_categories()
                   10091: 
                   10092: Converts category definitions - keys of categories hash stored in  
                   10093: coursecategories in configuration.db on the primary library server in a 
                   10094: domain - to an array.  Also generates javascript and idx hash used to 
                   10095: generate Domain Coordinator interface for editing Course Categories.
                   10096: 
                   10097: Inputs:
1.663     raeburn  10098: 
1.655     raeburn  10099: categories (reference to hash of category definitions).
1.663     raeburn  10100: 
1.655     raeburn  10101: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   10102:       categories and subcategories).
1.663     raeburn  10103: 
1.655     raeburn  10104: idx (reference to hash of counters used in Domain Coordinator interface for 
                   10105:       editing Course Categories).
1.663     raeburn  10106: 
1.655     raeburn  10107: jsarray (reference to array of categories used to create Javascript arrays for
                   10108:          Domain Coordinator interface for editing Course Categories).
                   10109: 
                   10110: Returns: nothing
                   10111: 
                   10112: Side effects: populates cats, idx and jsarray. 
                   10113: 
                   10114: =cut
                   10115: 
                   10116: sub gather_categories {
                   10117:     my ($categories,$cats,$idx,$jsarray) = @_;
                   10118:     my %counters;
                   10119:     my $num = 0;
                   10120:     foreach my $item (keys(%{$categories})) {
                   10121:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   10122:         if ($container eq '' && $depth == 0) {
                   10123:             $cats->[$depth][$categories->{$item}] = $cat;
                   10124:         } else {
                   10125:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   10126:         }
                   10127:         my ($escitem,$tail) = split(/:/,$item,2);
                   10128:         if ($counters{$tail} eq '') {
                   10129:             $counters{$tail} = $num;
                   10130:             $num ++;
                   10131:         }
                   10132:         if (ref($idx) eq 'HASH') {
                   10133:             $idx->{$item} = $counters{$tail};
                   10134:         }
                   10135:         if (ref($jsarray) eq 'ARRAY') {
                   10136:             push(@{$jsarray->[$counters{$tail}]},$item);
                   10137:         }
                   10138:     }
                   10139:     return;
                   10140: }
                   10141: 
                   10142: =pod
                   10143: 
                   10144: =item * &extract_categories()
                   10145: 
                   10146: Used to generate breadcrumb trails for course categories.
                   10147: 
                   10148: Inputs:
1.663     raeburn  10149: 
1.655     raeburn  10150: categories (reference to hash of category definitions).
1.663     raeburn  10151: 
1.655     raeburn  10152: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   10153:       categories and subcategories).
1.663     raeburn  10154: 
1.655     raeburn  10155: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  10156: 
1.655     raeburn  10157: allitems (reference to hash - key is category key 
                   10158:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  10159: 
1.655     raeburn  10160: idx (reference to hash of counters used in Domain Coordinator interface for
                   10161:       editing Course Categories).
1.663     raeburn  10162: 
1.655     raeburn  10163: jsarray (reference to array of categories used to create Javascript arrays for
                   10164:          Domain Coordinator interface for editing Course Categories).
                   10165: 
1.665     raeburn  10166: subcats (reference to hash of arrays containing all subcategories within each 
                   10167:          category, -recursive)
                   10168: 
1.655     raeburn  10169: Returns: nothing
                   10170: 
                   10171: Side effects: populates trails and allitems hash references.
                   10172: 
                   10173: =cut
                   10174: 
                   10175: sub extract_categories {
1.665     raeburn  10176:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  10177:     if (ref($categories) eq 'HASH') {
                   10178:         &gather_categories($categories,$cats,$idx,$jsarray);
                   10179:         if (ref($cats->[0]) eq 'ARRAY') {
                   10180:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   10181:                 my $name = $cats->[0][$i];
                   10182:                 my $item = &escape($name).'::0';
                   10183:                 my $trailstr;
                   10184:                 if ($name eq 'instcode') {
                   10185:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  10186:                 } elsif ($name eq 'communities') {
                   10187:                     $trailstr = &mt('Communities');
1.655     raeburn  10188:                 } else {
                   10189:                     $trailstr = $name;
                   10190:                 }
                   10191:                 if ($allitems->{$item} eq '') {
                   10192:                     push(@{$trails},$trailstr);
                   10193:                     $allitems->{$item} = scalar(@{$trails})-1;
                   10194:                 }
                   10195:                 my @parents = ($name);
                   10196:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   10197:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   10198:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  10199:                         if (ref($subcats) eq 'HASH') {
                   10200:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   10201:                         }
                   10202:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   10203:                     }
                   10204:                 } else {
                   10205:                     if (ref($subcats) eq 'HASH') {
                   10206:                         $subcats->{$item} = [];
1.655     raeburn  10207:                     }
                   10208:                 }
                   10209:             }
                   10210:         }
                   10211:     }
                   10212:     return;
                   10213: }
                   10214: 
                   10215: =pod
                   10216: 
                   10217: =item *&recurse_categories()
                   10218: 
                   10219: Recursively used to generate breadcrumb trails for course categories.
                   10220: 
                   10221: Inputs:
1.663     raeburn  10222: 
1.655     raeburn  10223: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   10224:       categories and subcategories).
1.663     raeburn  10225: 
1.655     raeburn  10226: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  10227: 
                   10228: category (current course category, for which breadcrumb trail is being generated).
                   10229: 
                   10230: trails (reference to array of breadcrumb trails for each category).
                   10231: 
1.655     raeburn  10232: allitems (reference to hash - key is category key
                   10233:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  10234: 
1.655     raeburn  10235: parents (array containing containers directories for current category, 
                   10236:          back to top level). 
                   10237: 
                   10238: Returns: nothing
                   10239: 
                   10240: Side effects: populates trails and allitems hash references
                   10241: 
                   10242: =cut
                   10243: 
                   10244: sub recurse_categories {
1.665     raeburn  10245:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  10246:     my $shallower = $depth - 1;
                   10247:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   10248:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   10249:             my $name = $cats->[$depth]{$category}[$k];
                   10250:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   10251:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   10252:             if ($allitems->{$item} eq '') {
                   10253:                 push(@{$trails},$trailstr);
                   10254:                 $allitems->{$item} = scalar(@{$trails})-1;
                   10255:             }
                   10256:             my $deeper = $depth+1;
                   10257:             push(@{$parents},$category);
1.665     raeburn  10258:             if (ref($subcats) eq 'HASH') {
                   10259:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   10260:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   10261:                     my $higher;
                   10262:                     if ($j > 0) {
                   10263:                         $higher = &escape($parents->[$j]).':'.
                   10264:                                   &escape($parents->[$j-1]).':'.$j;
                   10265:                     } else {
                   10266:                         $higher = &escape($parents->[$j]).'::'.$j;
                   10267:                     }
                   10268:                     push(@{$subcats->{$higher}},$subcat);
                   10269:                 }
                   10270:             }
                   10271:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   10272:                                 $subcats);
1.655     raeburn  10273:             pop(@{$parents});
                   10274:         }
                   10275:     } else {
                   10276:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   10277:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   10278:         if ($allitems->{$item} eq '') {
                   10279:             push(@{$trails},$trailstr);
                   10280:             $allitems->{$item} = scalar(@{$trails})-1;
                   10281:         }
                   10282:     }
                   10283:     return;
                   10284: }
                   10285: 
1.663     raeburn  10286: =pod
                   10287: 
                   10288: =item *&assign_categories_table()
                   10289: 
                   10290: Create a datatable for display of hierarchical categories in a domain,
                   10291: with checkboxes to allow a course to be categorized. 
                   10292: 
                   10293: Inputs:
                   10294: 
                   10295: cathash - reference to hash of categories defined for the domain (from
                   10296:           configuration.db)
                   10297: 
                   10298: currcat - scalar with an & separated list of categories assigned to a course. 
                   10299: 
1.919     raeburn  10300: type    - scalar contains course type (Course or Community).
                   10301: 
1.663     raeburn  10302: Returns: $output (markup to be displayed) 
                   10303: 
                   10304: =cut
                   10305: 
                   10306: sub assign_categories_table {
1.919     raeburn  10307:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  10308:     my $output;
                   10309:     if (ref($cathash) eq 'HASH') {
                   10310:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   10311:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   10312:         $maxdepth = scalar(@cats);
                   10313:         if (@cats > 0) {
                   10314:             my $itemcount = 0;
                   10315:             if (ref($cats[0]) eq 'ARRAY') {
                   10316:                 my @currcategories;
                   10317:                 if ($currcat ne '') {
                   10318:                     @currcategories = split('&',$currcat);
                   10319:                 }
1.919     raeburn  10320:                 my $table;
1.663     raeburn  10321:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   10322:                     my $parent = $cats[0][$i];
1.919     raeburn  10323:                     next if ($parent eq 'instcode');
                   10324:                     if ($type eq 'Community') {
                   10325:                         next unless ($parent eq 'communities');
                   10326:                     } else {
                   10327:                         next if ($parent eq 'communities');
                   10328:                     }
1.663     raeburn  10329:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   10330:                     my $item = &escape($parent).'::0';
                   10331:                     my $checked = '';
                   10332:                     if (@currcategories > 0) {
                   10333:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   10334:                             $checked = ' checked="checked"';
1.663     raeburn  10335:                         }
                   10336:                     }
1.919     raeburn  10337:                     my $parent_title = $parent;
                   10338:                     if ($parent eq 'communities') {
                   10339:                         $parent_title = &mt('Communities');
                   10340:                     }
                   10341:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   10342:                               '<input type="checkbox" name="usecategory" value="'.
                   10343:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   10344:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  10345:                     my $depth = 1;
                   10346:                     push(@path,$parent);
1.919     raeburn  10347:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  10348:                     pop(@path);
1.919     raeburn  10349:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  10350:                     $itemcount ++;
                   10351:                 }
1.919     raeburn  10352:                 if ($itemcount) {
                   10353:                     $output = &Apache::loncommon::start_data_table().
                   10354:                               $table.
                   10355:                               &Apache::loncommon::end_data_table();
                   10356:                 }
1.663     raeburn  10357:             }
                   10358:         }
                   10359:     }
                   10360:     return $output;
                   10361: }
                   10362: 
                   10363: =pod
                   10364: 
                   10365: =item *&assign_category_rows()
                   10366: 
                   10367: Create a datatable row for display of nested categories in a domain,
                   10368: with checkboxes to allow a course to be categorized,called recursively.
                   10369: 
                   10370: Inputs:
                   10371: 
                   10372: itemcount - track row number for alternating colors
                   10373: 
                   10374: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   10375:       categories and subcategories.
                   10376: 
                   10377: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   10378: 
                   10379: parent - parent of current category item
                   10380: 
                   10381: path - Array containing all categories back up through the hierarchy from the
                   10382:        current category to the top level.
                   10383: 
                   10384: currcategories - reference to array of current categories assigned to the course
                   10385: 
                   10386: Returns: $output (markup to be displayed).
                   10387: 
                   10388: =cut
                   10389: 
                   10390: sub assign_category_rows {
                   10391:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   10392:     my ($text,$name,$item,$chgstr);
                   10393:     if (ref($cats) eq 'ARRAY') {
                   10394:         my $maxdepth = scalar(@{$cats});
                   10395:         if (ref($cats->[$depth]) eq 'HASH') {
                   10396:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   10397:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   10398:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   10399:                 $text .= '<td><table class="LC_datatable">';
                   10400:                 for (my $j=0; $j<$numchildren; $j++) {
                   10401:                     $name = $cats->[$depth]{$parent}[$j];
                   10402:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   10403:                     my $deeper = $depth+1;
                   10404:                     my $checked = '';
                   10405:                     if (ref($currcategories) eq 'ARRAY') {
                   10406:                         if (@{$currcategories} > 0) {
                   10407:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   10408:                                 $checked = ' checked="checked"';
1.663     raeburn  10409:                             }
                   10410:                         }
                   10411:                     }
1.664     raeburn  10412:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   10413:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  10414:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   10415:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   10416:                              '</td><td>';
1.663     raeburn  10417:                     if (ref($path) eq 'ARRAY') {
                   10418:                         push(@{$path},$name);
                   10419:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   10420:                         pop(@{$path});
                   10421:                     }
                   10422:                     $text .= '</td></tr>';
                   10423:                 }
                   10424:                 $text .= '</table></td>';
                   10425:             }
                   10426:         }
                   10427:     }
                   10428:     return $text;
                   10429: }
                   10430: 
1.655     raeburn  10431: ############################################################
                   10432: ############################################################
                   10433: 
                   10434: 
1.443     albertel 10435: sub commit_customrole {
1.664     raeburn  10436:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  10437:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 10438:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   10439:                          ($end?', ending '.localtime($end):'').': <b>'.
                   10440:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  10441:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 10442:                  '</b><br />';
                   10443:     return $output;
                   10444: }
                   10445: 
                   10446: sub commit_standardrole {
1.541     raeburn  10447:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
                   10448:     my ($output,$logmsg,$linefeed);
                   10449:     if ($context eq 'auto') {
                   10450:         $linefeed = "\n";
                   10451:     } else {
                   10452:         $linefeed = "<br />\n";
                   10453:     }  
1.443     albertel 10454:     if ($three eq 'st') {
1.541     raeburn  10455:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                   10456:                                          $one,$two,$sec,$context);
                   10457:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  10458:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   10459:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 10460:         } else {
1.541     raeburn  10461:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 10462:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  10463:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   10464:             if ($context eq 'auto') {
                   10465:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   10466:             } else {
                   10467:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   10468:                &mt('Add to classlist').': <b>ok</b>';
                   10469:             }
                   10470:             $output .= $linefeed;
1.443     albertel 10471:         }
                   10472:     } else {
                   10473:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   10474:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  10475:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  10476:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  10477:         if ($context eq 'auto') {
                   10478:             $output .= $result.$linefeed;
                   10479:         } else {
                   10480:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   10481:         }
1.443     albertel 10482:     }
                   10483:     return $output;
                   10484: }
                   10485: 
                   10486: sub commit_studentrole {
1.541     raeburn  10487:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626     raeburn  10488:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  10489:     if ($context eq 'auto') {
                   10490:         $linefeed = "\n";
                   10491:     } else {
                   10492:         $linefeed = '<br />'."\n";
                   10493:     }
1.443     albertel 10494:     if (defined($one) && defined($two)) {
                   10495:         my $cid=$one.'_'.$two;
                   10496:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   10497:         my $secchange = 0;
                   10498:         my $expire_role_result;
                   10499:         my $modify_section_result;
1.628     raeburn  10500:         if ($oldsec ne '-1') { 
                   10501:             if ($oldsec ne $sec) {
1.443     albertel 10502:                 $secchange = 1;
1.628     raeburn  10503:                 my $now = time;
1.443     albertel 10504:                 my $uurl='/'.$cid;
                   10505:                 $uurl=~s/\_/\//g;
                   10506:                 if ($oldsec) {
                   10507:                     $uurl.='/'.$oldsec;
                   10508:                 }
1.626     raeburn  10509:                 $oldsecurl = $uurl;
1.628     raeburn  10510:                 $expire_role_result = 
1.652     raeburn  10511:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  10512:                 if ($env{'request.course.sec'} ne '') { 
                   10513:                     if ($expire_role_result eq 'refused') {
                   10514:                         my @roles = ('st');
                   10515:                         my @statuses = ('previous');
                   10516:                         my @roledoms = ($one);
                   10517:                         my $withsec = 1;
                   10518:                         my %roleshash = 
                   10519:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   10520:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   10521:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   10522:                             my ($oldstart,$oldend) = 
                   10523:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   10524:                             if ($oldend > 0 && $oldend <= $now) {
                   10525:                                 $expire_role_result = 'ok';
                   10526:                             }
                   10527:                         }
                   10528:                     }
                   10529:                 }
1.443     albertel 10530:                 $result = $expire_role_result;
                   10531:             }
                   10532:         }
                   10533:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652     raeburn  10534:             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443     albertel 10535:             if ($modify_section_result =~ /^ok/) {
                   10536:                 if ($secchange == 1) {
1.628     raeburn  10537:                     if ($sec eq '') {
                   10538:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   10539:                     } else {
                   10540:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   10541:                     }
1.443     albertel 10542:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  10543:                     if ($sec eq '') {
                   10544:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   10545:                     } else {
                   10546:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   10547:                     }
1.443     albertel 10548:                 } else {
1.628     raeburn  10549:                     if ($sec eq '') {
                   10550:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   10551:                     } else {
                   10552:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   10553:                     }
1.443     albertel 10554:                 }
                   10555:             } else {
1.628     raeburn  10556:                 if ($secchange) {       
                   10557:                     $$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;
                   10558:                 } else {
                   10559:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   10560:                 }
1.443     albertel 10561:             }
                   10562:             $result = $modify_section_result;
                   10563:         } elsif ($secchange == 1) {
1.628     raeburn  10564:             if ($oldsec eq '') {
                   10565:                 $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
                   10566:             } else {
                   10567:                 $$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;
                   10568:             }
1.626     raeburn  10569:             if ($expire_role_result eq 'refused') {
                   10570:                 my $newsecurl = '/'.$cid;
                   10571:                 $newsecurl =~ s/\_/\//g;
                   10572:                 if ($sec ne '') {
                   10573:                     $newsecurl.='/'.$sec;
                   10574:                 }
                   10575:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   10576:                     if ($sec eq '') {
                   10577:                         $$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;
                   10578:                     } else {
                   10579:                         $$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;
                   10580:                     }
                   10581:                 }
                   10582:             }
1.443     albertel 10583:         }
                   10584:     } else {
1.626     raeburn  10585:         $$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 10586:         $result = "error: incomplete course id\n";
                   10587:     }
                   10588:     return $result;
                   10589: }
                   10590: 
                   10591: ############################################################
                   10592: ############################################################
                   10593: 
1.566     albertel 10594: sub check_clone {
1.578     raeburn  10595:     my ($args,$linefeed) = @_;
1.566     albertel 10596:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   10597:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   10598:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   10599:     my $clonemsg;
                   10600:     my $can_clone = 0;
1.944     raeburn  10601:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  10602:     if ($lctype ne 'community') {
                   10603:         $lctype = 'course';
                   10604:     }
1.566     albertel 10605:     if ($clonehome eq 'no_host') {
1.944     raeburn  10606:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  10607:             $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'});
                   10608:         } else {
                   10609:             $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'});
                   10610:         }     
1.566     albertel 10611:     } else {
                   10612: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  10613:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  10614:             if ($clonedesc{'type'} ne 'Community') {
                   10615:                  $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'});
                   10616:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   10617:             }
                   10618:         }
1.882     raeburn  10619: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   10620:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 10621: 	    $can_clone = 1;
                   10622: 	} else {
                   10623: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   10624: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   10625: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  10626:             if (grep(/^\*$/,@cloners)) {
                   10627:                 $can_clone = 1;
                   10628:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   10629:                 $can_clone = 1;
                   10630:             } else {
1.908     raeburn  10631:                 my $ccrole = 'cc';
1.944     raeburn  10632:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  10633:                     $ccrole = 'co';
                   10634:                 }
1.578     raeburn  10635: 	        my %roleshash =
                   10636: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   10637: 					 $args->{'ccdomain'},
1.908     raeburn  10638:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  10639: 					 [$args->{'clonedomain'}]);
1.908     raeburn  10640: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  10641:                     $can_clone = 1;
                   10642:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   10643:                     $can_clone = 1;
                   10644:                 } else {
1.944     raeburn  10645:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  10646:                         $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'});
                   10647:                     } else {
                   10648:                         $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'});
                   10649:                     }
1.578     raeburn  10650: 	        }
1.566     albertel 10651: 	    }
1.578     raeburn  10652:         }
1.566     albertel 10653:     }
                   10654:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   10655: }
                   10656: 
1.444     albertel 10657: sub construct_course {
1.885     raeburn  10658:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 10659:     my $outcome;
1.541     raeburn  10660:     my $linefeed =  '<br />'."\n";
                   10661:     if ($context eq 'auto') {
                   10662:         $linefeed = "\n";
                   10663:     }
1.566     albertel 10664: 
                   10665: #
                   10666: # Are we cloning?
                   10667: #
                   10668:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   10669:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  10670: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 10671: 	if ($context ne 'auto') {
1.578     raeburn  10672:             if ($clonemsg ne '') {
                   10673: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   10674:             }
1.566     albertel 10675: 	}
                   10676: 	$outcome .= $clonemsg.$linefeed;
                   10677: 
                   10678:         if (!$can_clone) {
                   10679: 	    return (0,$outcome);
                   10680: 	}
                   10681:     }
                   10682: 
1.444     albertel 10683: #
                   10684: # Open course
                   10685: #
                   10686:     my $crstype = lc($args->{'crstype'});
                   10687:     my %cenv=();
                   10688:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   10689:                                              $args->{'cdescr'},
                   10690:                                              $args->{'curl'},
                   10691:                                              $args->{'course_home'},
                   10692:                                              $args->{'nonstandard'},
                   10693:                                              $args->{'crscode'},
                   10694:                                              $args->{'ccuname'}.':'.
                   10695:                                              $args->{'ccdomain'},
1.882     raeburn  10696:                                              $args->{'crstype'},
1.885     raeburn  10697:                                              $cnum,$context,$category);
1.444     albertel 10698: 
                   10699:     # Note: The testing routines depend on this being output; see 
                   10700:     # Utils::Course. This needs to at least be output as a comment
                   10701:     # if anyone ever decides to not show this, and Utils::Course::new
                   10702:     # will need to be suitably modified.
1.541     raeburn  10703:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  10704:     if ($$courseid =~ /^error:/) {
                   10705:         return (0,$outcome);
                   10706:     }
                   10707: 
1.444     albertel 10708: #
                   10709: # Check if created correctly
                   10710: #
1.479     albertel 10711:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 10712:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  10713:     if ($crsuhome eq 'no_host') {
                   10714:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   10715:         return (0,$outcome);
                   10716:     }
1.541     raeburn  10717:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 10718: 
1.444     albertel 10719: #
1.566     albertel 10720: # Do the cloning
                   10721: #   
                   10722:     if ($can_clone && $cloneid) {
                   10723: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   10724: 	if ($context ne 'auto') {
                   10725: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   10726: 	}
                   10727: 	$outcome .= $clonemsg.$linefeed;
                   10728: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 10729: # Copy all files
1.637     www      10730: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 10731: # Restore URL
1.566     albertel 10732: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 10733: # Restore title
1.566     albertel 10734: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  10735: # Restore creation date, creator and creation context.
                   10736:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   10737:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   10738:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 10739: # Mark as cloned
1.566     albertel 10740: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      10741: # Need to clone grading mode
                   10742:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   10743:         $cenv{'grading'}=$newenv{'grading'};
                   10744: # Do not clone these environment entries
                   10745:         &Apache::lonnet::del('environment',
                   10746:                   ['default_enrollment_start_date',
                   10747:                    'default_enrollment_end_date',
                   10748:                    'question.email',
                   10749:                    'policy.email',
                   10750:                    'comment.email',
                   10751:                    'pch.users.denied',
1.725     raeburn  10752:                    'plc.users.denied',
                   10753:                    'hidefromcat',
                   10754:                    'categories'],
1.638     www      10755:                    $$crsudom,$$crsunum);
1.444     albertel 10756:     }
1.566     albertel 10757: 
1.444     albertel 10758: #
                   10759: # Set environment (will override cloned, if existing)
                   10760: #
                   10761:     my @sections = ();
                   10762:     my @xlists = ();
                   10763:     if ($args->{'crstype'}) {
                   10764:         $cenv{'type'}=$args->{'crstype'};
                   10765:     }
                   10766:     if ($args->{'crsid'}) {
                   10767:         $cenv{'courseid'}=$args->{'crsid'};
                   10768:     }
                   10769:     if ($args->{'crscode'}) {
                   10770:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   10771:     }
                   10772:     if ($args->{'crsquota'} ne '') {
                   10773:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   10774:     } else {
                   10775:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   10776:     }
                   10777:     if ($args->{'ccuname'}) {
                   10778:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   10779:                                         ':'.$args->{'ccdomain'};
                   10780:     } else {
                   10781:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   10782:     }
                   10783:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   10784:     if ($args->{'crssections'}) {
                   10785:         $cenv{'internal.sectionnums'} = '';
                   10786:         if ($args->{'crssections'} =~ m/,/) {
                   10787:             @sections = split/,/,$args->{'crssections'};
                   10788:         } else {
                   10789:             $sections[0] = $args->{'crssections'};
                   10790:         }
                   10791:         if (@sections > 0) {
                   10792:             foreach my $item (@sections) {
                   10793:                 my ($sec,$gp) = split/:/,$item;
                   10794:                 my $class = $args->{'crscode'}.$sec;
                   10795:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   10796:                 $cenv{'internal.sectionnums'} .= $item.',';
                   10797:                 unless ($addcheck eq 'ok') {
                   10798:                     push @badclasses, $class;
                   10799:                 }
                   10800:             }
                   10801:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   10802:         }
                   10803:     }
                   10804: # do not hide course coordinator from staff listing, 
                   10805: # even if privileged
                   10806:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   10807: # add crosslistings
                   10808:     if ($args->{'crsxlist'}) {
                   10809:         $cenv{'internal.crosslistings'}='';
                   10810:         if ($args->{'crsxlist'} =~ m/,/) {
                   10811:             @xlists = split/,/,$args->{'crsxlist'};
                   10812:         } else {
                   10813:             $xlists[0] = $args->{'crsxlist'};
                   10814:         }
                   10815:         if (@xlists > 0) {
                   10816:             foreach my $item (@xlists) {
                   10817:                 my ($xl,$gp) = split/:/,$item;
                   10818:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   10819:                 $cenv{'internal.crosslistings'} .= $item.',';
                   10820:                 unless ($addcheck eq 'ok') {
                   10821:                     push @badclasses, $xl;
                   10822:                 }
                   10823:             }
                   10824:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   10825:         }
                   10826:     }
                   10827:     if ($args->{'autoadds'}) {
                   10828:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   10829:     }
                   10830:     if ($args->{'autodrops'}) {
                   10831:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   10832:     }
                   10833: # check for notification of enrollment changes
                   10834:     my @notified = ();
                   10835:     if ($args->{'notify_owner'}) {
                   10836:         if ($args->{'ccuname'} ne '') {
                   10837:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   10838:         }
                   10839:     }
                   10840:     if ($args->{'notify_dc'}) {
                   10841:         if ($uname ne '') { 
1.630     raeburn  10842:             push(@notified,$uname.':'.$udom);
1.444     albertel 10843:         }
                   10844:     }
                   10845:     if (@notified > 0) {
                   10846:         my $notifylist;
                   10847:         if (@notified > 1) {
                   10848:             $notifylist = join(',',@notified);
                   10849:         } else {
                   10850:             $notifylist = $notified[0];
                   10851:         }
                   10852:         $cenv{'internal.notifylist'} = $notifylist;
                   10853:     }
                   10854:     if (@badclasses > 0) {
                   10855:         my %lt=&Apache::lonlocal::texthash(
                   10856:                 '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',
                   10857:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   10858:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   10859:         );
1.541     raeburn  10860:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   10861:                            ' ('.$lt{'adby'}.')';
                   10862:         if ($context eq 'auto') {
                   10863:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 10864:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  10865:             foreach my $item (@badclasses) {
                   10866:                 if ($context eq 'auto') {
                   10867:                     $outcome .= " - $item\n";
                   10868:                 } else {
                   10869:                     $outcome .= "<li>$item</li>\n";
                   10870:                 }
                   10871:             }
                   10872:             if ($context eq 'auto') {
                   10873:                 $outcome .= $linefeed;
                   10874:             } else {
1.566     albertel 10875:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  10876:             }
                   10877:         } 
1.444     albertel 10878:     }
                   10879:     if ($args->{'no_end_date'}) {
                   10880:         $args->{'endaccess'} = 0;
                   10881:     }
                   10882:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   10883:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   10884:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   10885:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   10886:     if ($args->{'showphotos'}) {
                   10887:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   10888:     }
                   10889:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   10890:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   10891:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   10892:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  10893:             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'); 
                   10894:             if ($context eq 'auto') {
                   10895:                 $outcome .= $krb_msg;
                   10896:             } else {
1.566     albertel 10897:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  10898:             }
                   10899:             $outcome .= $linefeed;
1.444     albertel 10900:         }
                   10901:     }
                   10902:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   10903:        if ($args->{'setpolicy'}) {
                   10904:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   10905:        }
                   10906:        if ($args->{'setcontent'}) {
                   10907:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   10908:        }
                   10909:     }
                   10910:     if ($args->{'reshome'}) {
                   10911: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   10912: 	$cenv{'reshome'}=~s/\/+$/\//;
                   10913:     }
                   10914: #
                   10915: # course has keyed access
                   10916: #
                   10917:     if ($args->{'setkeys'}) {
                   10918:        $cenv{'keyaccess'}='yes';
                   10919:     }
                   10920: # if specified, key authority is not course, but user
                   10921: # only active if keyaccess is yes
                   10922:     if ($args->{'keyauth'}) {
1.487     albertel 10923: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   10924: 	$user = &LONCAPA::clean_username($user);
                   10925: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     10926: 	if ($user ne '' && $domain ne '') {
1.487     albertel 10927: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 10928: 	}
                   10929:     }
                   10930: 
                   10931:     if ($args->{'disresdis'}) {
                   10932:         $cenv{'pch.roles.denied'}='st';
                   10933:     }
                   10934:     if ($args->{'disablechat'}) {
                   10935:         $cenv{'plc.roles.denied'}='st';
                   10936:     }
                   10937: 
                   10938:     # Record we've not yet viewed the Course Initialization Helper for this 
                   10939:     # course
                   10940:     $cenv{'course.helper.not.run'} = 1;
                   10941:     #
                   10942:     # Use new Randomseed
                   10943:     #
                   10944:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   10945:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   10946:     #
                   10947:     # The encryption code and receipt prefix for this course
                   10948:     #
                   10949:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   10950:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   10951:     #
                   10952:     # By default, use standard grading
                   10953:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   10954: 
1.541     raeburn  10955:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   10956:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 10957: #
                   10958: # Open all assignments
                   10959: #
                   10960:     if ($args->{'openall'}) {
                   10961:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   10962:        my %storecontent = ($storeunder         => time,
                   10963:                            $storeunder.'.type' => 'date_start');
                   10964:        
                   10965:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  10966:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 10967:    }
                   10968: #
                   10969: # Set first page
                   10970: #
                   10971:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   10972: 	    || ($cloneid)) {
1.445     albertel 10973: 	use LONCAPA::map;
1.444     albertel 10974: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 10975: 
                   10976: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   10977:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   10978: 
1.444     albertel 10979:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   10980:         my $title; my $url;
                   10981:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   10982: 	    $title=&mt('Syllabus');
1.444     albertel 10983:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   10984:         } else {
1.963     raeburn  10985:             $title=&mt('Table of Contents');
1.444     albertel 10986:             $url='/adm/navmaps';
                   10987:         }
1.445     albertel 10988: 
                   10989:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   10990: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   10991: 
                   10992: 	if ($errtext) { $fatal=2; }
1.541     raeburn  10993:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 10994:     }
1.566     albertel 10995: 
                   10996:     return (1,$outcome);
1.444     albertel 10997: }
                   10998: 
                   10999: ############################################################
                   11000: ############################################################
                   11001: 
1.953     droeschl 11002: #SD
                   11003: # only Community and Course, or anything else?
1.378     raeburn  11004: sub course_type {
                   11005:     my ($cid) = @_;
                   11006:     if (!defined($cid)) {
                   11007:         $cid = $env{'request.course.id'};
                   11008:     }
1.404     albertel 11009:     if (defined($env{'course.'.$cid.'.type'})) {
                   11010:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  11011:     } else {
                   11012:         return 'Course';
1.377     raeburn  11013:     }
                   11014: }
1.156     albertel 11015: 
1.406     raeburn  11016: sub group_term {
                   11017:     my $crstype = &course_type();
                   11018:     my %names = (
                   11019:                   'Course' => 'group',
1.865     raeburn  11020:                   'Community' => 'group',
1.406     raeburn  11021:                 );
                   11022:     return $names{$crstype};
                   11023: }
                   11024: 
1.902     raeburn  11025: sub course_types {
                   11026:     my @types = ('official','unofficial','community');
                   11027:     my %typename = (
                   11028:                          official   => 'Official course',
                   11029:                          unofficial => 'Unofficial course',
                   11030:                          community  => 'Community',
                   11031:                    );
                   11032:     return (\@types,\%typename);
                   11033: }
                   11034: 
1.156     albertel 11035: sub icon {
                   11036:     my ($file)=@_;
1.505     albertel 11037:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 11038:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 11039:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 11040:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   11041: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   11042: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   11043: 	            $curfext.".gif") {
                   11044: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   11045: 		$curfext.".gif";
                   11046: 	}
                   11047:     }
1.249     albertel 11048:     return &lonhttpdurl($iconname);
1.154     albertel 11049: } 
1.84      albertel 11050: 
1.575     albertel 11051: sub lonhttpdurl {
1.692     www      11052: #
                   11053: # Had been used for "small fry" static images on separate port 8080.
                   11054: # Modify here if lightweight http functionality desired again.
                   11055: # Currently eliminated due to increasing firewall issues.
                   11056: #
1.575     albertel 11057:     my ($url)=@_;
1.692     www      11058:     return $url;
1.215     albertel 11059: }
                   11060: 
1.213     albertel 11061: sub connection_aborted {
                   11062:     my ($r)=@_;
                   11063:     $r->print(" ");$r->rflush();
                   11064:     my $c = $r->connection;
                   11065:     return $c->aborted();
                   11066: }
                   11067: 
1.221     foxr     11068: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     11069: #    strings as 'strings'.
                   11070: sub escape_single {
1.221     foxr     11071:     my ($input) = @_;
1.223     albertel 11072:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     11073:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   11074:     return $input;
                   11075: }
1.223     albertel 11076: 
1.222     foxr     11077: #  Same as escape_single, but escape's "'s  This 
                   11078: #  can be used for  "strings"
                   11079: sub escape_double {
                   11080:     my ($input) = @_;
                   11081:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   11082:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   11083:     return $input;
                   11084: }
1.223     albertel 11085:  
1.222     foxr     11086: #   Escapes the last element of a full URL.
                   11087: sub escape_url {
                   11088:     my ($url)   = @_;
1.238     raeburn  11089:     my @urlslices = split(/\//, $url,-1);
1.369     www      11090:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 11091:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     11092: }
1.462     albertel 11093: 
1.820     raeburn  11094: sub compare_arrays {
                   11095:     my ($arrayref1,$arrayref2) = @_;
                   11096:     my (@difference,%count);
                   11097:     @difference = ();
                   11098:     %count = ();
                   11099:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   11100:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   11101:         foreach my $element (keys(%count)) {
                   11102:             if ($count{$element} == 1) {
                   11103:                 push(@difference,$element);
                   11104:             }
                   11105:         }
                   11106:     }
                   11107:     return @difference;
                   11108: }
                   11109: 
1.817     bisitz   11110: # -------------------------------------------------------- Initialize user login
1.462     albertel 11111: sub init_user_environment {
1.463     albertel 11112:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 11113:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   11114: 
                   11115:     my $public=($username eq 'public' && $domain eq 'public');
                   11116: 
                   11117: # See if old ID present, if so, remove
                   11118: 
                   11119:     my ($filename,$cookie,$userroles);
                   11120:     my $now=time;
                   11121: 
                   11122:     if ($public) {
                   11123: 	my $max_public=100;
                   11124: 	my $oldest;
                   11125: 	my $oldest_time=0;
                   11126: 	for(my $next=1;$next<=$max_public;$next++) {
                   11127: 	    if (-e $lonids."/publicuser_$next.id") {
                   11128: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   11129: 		if ($mtime<$oldest_time || !$oldest_time) {
                   11130: 		    $oldest_time=$mtime;
                   11131: 		    $oldest=$next;
                   11132: 		}
                   11133: 	    } else {
                   11134: 		$cookie="publicuser_$next";
                   11135: 		last;
                   11136: 	    }
                   11137: 	}
                   11138: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   11139:     } else {
1.463     albertel 11140: 	# if this isn't a robot, kill any existing non-robot sessions
                   11141: 	if (!$args->{'robot'}) {
                   11142: 	    opendir(DIR,$lonids);
                   11143: 	    while ($filename=readdir(DIR)) {
                   11144: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   11145: 		    unlink($lonids.'/'.$filename);
                   11146: 		}
1.462     albertel 11147: 	    }
1.463     albertel 11148: 	    closedir(DIR);
1.462     albertel 11149: 	}
                   11150: # Give them a new cookie
1.463     albertel 11151: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      11152: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 11153: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 11154:     
                   11155: # Initialize roles
                   11156: 
                   11157: 	$userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
                   11158:     }
                   11159: # ------------------------------------ Check browser type and MathML capability
                   11160: 
                   11161:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   11162:         $clientunicode,$clientos) = &decode_user_agent($r);
                   11163: 
                   11164: # ------------------------------------------------------------- Get environment
                   11165: 
                   11166:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   11167:     my ($tmp) = keys(%userenv);
                   11168:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   11169:     } else {
                   11170: 	undef(%userenv);
                   11171:     }
                   11172:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   11173: 	$form->{'interface'}=$userenv{'interface'};
                   11174:     }
                   11175:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   11176: 
                   11177: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   11178:     foreach my $option ('interface','localpath','localres') {
                   11179:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 11180:     }
                   11181: # --------------------------------------------------------- Write first profile
                   11182: 
                   11183:     {
                   11184: 	my %initial_env = 
                   11185: 	    ("user.name"          => $username,
                   11186: 	     "user.domain"        => $domain,
                   11187: 	     "user.home"          => $authhost,
                   11188: 	     "browser.type"       => $clientbrowser,
                   11189: 	     "browser.version"    => $clientversion,
                   11190: 	     "browser.mathml"     => $clientmathml,
                   11191: 	     "browser.unicode"    => $clientunicode,
                   11192: 	     "browser.os"         => $clientos,
                   11193: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   11194: 	     "request.course.fn"  => '',
                   11195: 	     "request.course.uri" => '',
                   11196: 	     "request.course.sec" => '',
                   11197: 	     "request.role"       => 'cm',
                   11198: 	     "request.role.adv"   => $env{'user.adv'},
                   11199: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   11200: 
                   11201:         if ($form->{'localpath'}) {
                   11202: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   11203: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   11204:         }
                   11205: 	
                   11206: 	if ($form->{'interface'}) {
                   11207: 	    $form->{'interface'}=~s/\W//gs;
                   11208: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   11209: 	    $env{'browser.interface'}=$form->{'interface'};
                   11210: 	}
                   11211: 
1.981     raeburn  11212:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.980     raeburn  11213:         my %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   11214: 
1.724     raeburn  11215:         foreach my $tool ('aboutme','blog','portfolio') {
                   11216:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  11217:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   11218:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  11219:         }
                   11220: 
1.864     raeburn  11221:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  11222:             $userenv{'canrequest.'.$crstype} =
                   11223:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  11224:                                                   'reload','requestcourses',
                   11225:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  11226:         }
                   11227: 
1.462     albertel 11228: 	$env{'user.environment'} = "$lonids/$cookie.id";
                   11229: 	
                   11230: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   11231: 		 &GDBM_WRCREAT(),0640)) {
                   11232: 	    &_add_to_env(\%disk_env,\%initial_env);
                   11233: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   11234: 	    &_add_to_env(\%disk_env,$userroles);
1.463     albertel 11235: 	    if (ref($args->{'extra_env'})) {
                   11236: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   11237: 	    }
1.462     albertel 11238: 	    untie(%disk_env);
                   11239: 	} else {
1.705     tempelho 11240: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   11241: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 11242: 	    return 'error: '.$!;
                   11243: 	}
                   11244:     }
                   11245:     $env{'request.role'}='cm';
                   11246:     $env{'request.role.adv'}=$env{'user.adv'};
                   11247:     $env{'browser.type'}=$clientbrowser;
                   11248: 
                   11249:     return $cookie;
                   11250: 
                   11251: }
                   11252: 
                   11253: sub _add_to_env {
                   11254:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  11255:     if (ref($env_data) eq 'HASH') {
                   11256:         while (my ($key,$value) = each(%$env_data)) {
                   11257: 	    $idf->{$prefix.$key} = $value;
                   11258: 	    $env{$prefix.$key}   = $value;
                   11259:         }
1.462     albertel 11260:     }
                   11261: }
                   11262: 
1.685     tempelho 11263: # --- Get the symbolic name of a problem and the url
                   11264: sub get_symb {
                   11265:     my ($request,$silent) = @_;
1.726     raeburn  11266:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 11267:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   11268:     if ($symb eq '') {
                   11269:         if (!$silent) {
                   11270:             $request->print("Unable to handle ambiguous references:$url:.");
                   11271:             return ();
                   11272:         }
                   11273:     }
                   11274:     &Apache::lonenc::check_decrypt(\$symb);
                   11275:     return ($symb);
                   11276: }
                   11277: 
                   11278: # --------------------------------------------------------------Get annotation
                   11279: 
                   11280: sub get_annotation {
                   11281:     my ($symb,$enc) = @_;
                   11282: 
                   11283:     my $key = $symb;
                   11284:     if (!$enc) {
                   11285:         $key =
                   11286:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   11287:     }
                   11288:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   11289:     return $annotation{$key};
                   11290: }
                   11291: 
                   11292: sub clean_symb {
1.731     raeburn  11293:     my ($symb,$delete_enc) = @_;
1.685     tempelho 11294: 
                   11295:     &Apache::lonenc::check_decrypt(\$symb);
                   11296:     my $enc = $env{'request.enc'};
1.731     raeburn  11297:     if ($delete_enc) {
1.730     raeburn  11298:         delete($env{'request.enc'});
                   11299:     }
1.685     tempelho 11300: 
                   11301:     return ($symb,$enc);
                   11302: }
1.462     albertel 11303: 
1.990     raeburn  11304: sub build_release_hashes {
                   11305:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   11306:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   11307:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   11308:                   (ref($randomizetry) eq 'HASH'));
                   11309:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   11310:         my ($item,$name,$value) = split(/:/,$key);
                   11311:         if ($item eq 'parameter') {
                   11312:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   11313:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   11314:                     push(@{$checkparms->{$name}},$value);
                   11315:                 }
                   11316:             } else {
                   11317:                 push(@{$checkparms->{$name}},$value);
                   11318:             }
                   11319:         } elsif ($item eq 'resourcetag') {
                   11320:             if ($name eq 'responsetype') {
                   11321:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   11322:             }
                   11323:         } elsif ($item eq 'course') {
                   11324:             if ($name eq 'crstype') {
                   11325:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   11326:             }
                   11327:         }
                   11328:     }
                   11329:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   11330:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   11331:     return;
                   11332: }
                   11333: 
1.41      ng       11334: =pod
                   11335: 
                   11336: =back
                   11337: 
1.112     bowersj2 11338: =cut
1.41      ng       11339: 
1.112     bowersj2 11340: 1;
                   11341: __END__;
1.41      ng       11342: 

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