[BACK]Return to lonhtmlcommon.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonhtmlcommon.pm between versions 1.39 and 1.56

version 1.39, 2004/01/02 16:34:03 version 1.56, 2004/02/24 23:19:15
Line 56  html. Line 56  html.
 package Apache::lonhtmlcommon;  package Apache::lonhtmlcommon;
   
 use Time::Local;  use Time::Local;
   use Time::HiRes;
 use Apache::lonlocal;  use Apache::lonlocal;
 use strict;  use strict;
   
   ##############################################
   ##############################################
   
   =pod
   
   =item authorbombs
   
   =cut
   
   ##############################################
   ##############################################
   
   sub authorbombs {
       my $url=shift;
       $url=&Apache::lonnet::declutter($url);
       my ($udom,$uname)=($url=~/^(\w+)\/(\w+)\//);
       my %bombs=&Apache::lonmsg::all_url_author_res_msg($uname,$udom);
       foreach (keys %bombs) {
    if ($_=~/^$udom\/$uname\//) {
       return '<a href="/adm/bombs/'.$url.
    '"><img src="/adm/lonMisc/bomb.gif" border="0" /></a>'.
    &Apache::loncommon::help_open_topic('About_Bombs');
    }
       }
       return '';
   }
   
 ##############################################  ##############################################
 ##############################################  ##############################################
   
   sub recent_filename {
       my $area=shift;
       return 'nohist_recent_'.&Apache::lonnet::escape($area);
   }
   
   sub store_recent {
       my ($area,$name,$value)=@_;
       my $file=&recent_filename($area);
       my %recent=&Apache::lonnet::dump($file);
       if (scalar(keys(%recent))>10) {
   # remove oldest value
    my $oldest=time;
    my $delkey='';
    foreach (keys %recent) {
       my $thistime=(split(/\&/,$recent{$_}))[0];
       if ($thistime<$oldest) {
    $oldest=$thistime;
    $delkey=$_;
       }
    }
    &Apache::lonnet::del($file,[$delkey]);
       }
   # store new value
       &Apache::lonnet::put($file,{ $name => 
    time.'&'.&Apache::lonnet::escape($value) });
   }
   
   sub select_recent {
       my ($area,$fieldname,$event)=@_;
       my %recent=&Apache::lonnet::dump(&recent_filename($area));
       my $return="\n<select name='$fieldname'".
    ($event?" onChange='$event'":'').
    ">\n<option value=''>--- ".&mt('Recent')." ---</option>";
       foreach (sort keys %recent) {
    unless ($_=~/^error\:/) {
       $return.="\n<option value='$_'>".
    &Apache::lonnet::unescape((split(/\&/,$recent{$_}))[1]).
    '</option>';
    }
       }
       $return.="\n</select>\n";
       return $return;
   }
   
   
 =pod  =pod
   
 =item textbox  =item textbox
Line 97  sub checkbox { Line 169  sub checkbox {
     return $Str;      return $Str;
 }  }
   
   
   
 ##############################################  ##############################################
 ##############################################  ##############################################
   
Line 455  sub StatusOptions { Line 525  sub StatusOptions {
     $Str .= '</select>'."\n";      $Str .= '</select>'."\n";
 }  }
   
   
 ########################################################  
 ########################################################  
   
 =pod  
   
 =item &MultipleSectionSelect()  
   
 Inputs:   
   
 =over 4  
   
 =item $sections A references to an array containing the names of all the  
 sections used in a class.  
   
 =item $selectedSections A reference to an array containing the names of the  
 currently selected sections.  
   
 =back   
   
 Returns: a string containing HTML for a multiple select box for  
 selecting sections of a course.    
   
 The form element name is 'Section'.  @$sections is sorted prior to output.  
   
 =cut  
   
 ########################################################  
 ########################################################  
 sub MultipleSectionSelect {  
     my ($sections,$selectedSections)=@_;  
   
     my $Str = '';  
     $Str .= '<select name="Section" multiple="true" size="4">'."\n";  
   
     foreach (sort @$sections) {  
         $Str .= '<option';  
         foreach my $selected (@$selectedSections) {  
             if($_ eq $selected) {  
                 $Str .= ' selected=""';  
             }  
         }  
         $Str .= '>'.$_.'</option>'."\n";  
     }  
     $Str .= '</select>'."\n";  
       
     return $Str;  
 }  
   
 ########################################################  
 ########################################################  
   
 =pod  
   
 =item &Title()  
   
 Inputs: $pageName a string containing the name of the page to be sent  
 to &Apache::loncommon::bodytag.  
   
 Returns: string containing being <html> and complete <head> and <title>  
 as well as a <script> to focus the current window and change its width  
 and height to 500.  Why?  I do not know.  If you find out, please update  
 this documentation.  
   
 =cut  
   
 ########################################################  
 ########################################################  
 sub Title {  
     my ($pageName)=@_;  
   
     my $Str = '';  
   
     $Str .= '<html><head><title>'.$pageName.'</title></head>'."\n";  
     $Str .= &Apache::loncommon::bodytag($pageName)."\n";  
     $Str .= '<script>window.focus(); window.width=500;window.height=500;';  
     $Str .= '</script>'."\n";  
   
     return $Str;  
 }  
   
 ########################################################  
 ########################################################  
   
 =pod  
   
 =item &CreateHeadings()  
   
 This function generates the column headings for the chart.  
   
 =over 4  
   
 Inputs: $CacheData, $keyID, $headings, $spacePadding  
   
 $CacheData: pointer to a hash tied to the cached data database  
   
 $keyID: a pointer to an array containing the names of the data   
 held in a column and is used as part of a key into $CacheData  
   
 $headings: The names of the headings for the student information  
   
 $spacePadding: The spaces to go between columns  
   
 Output: $Str  
   
 $Str: A formatted string of the table column headings.  
   
 =back  
   
 =cut  
   
 ########################################################  
 ########################################################  
 sub CreateHeadings {  
     my ($data,$keyID,$headings,$displayString,$format)=@_;  
     my $Str='';  
     my $formatting = '';  
   
     for(my $index=0; $index<(scalar @$headings); $index++) {  
   my $currentHeading=$headings->[$index];  
         if($format eq 'preformatted') {  
             my @dataLength=split(//,$currentHeading);  
             my $length=scalar @dataLength;  
             $formatting = (' 'x  
                       ($data->{$keyID->[$index].':columnWidth'}-$length));  
         }  
         my $linkdata=$keyID->[$index];  
   
         my $tempString = $displayString;  
         $tempString =~ s/LINKDATA/$linkdata/;  
         $tempString =~ s/DISPLAYDATA/$currentHeading/;  
         $tempString =~ s/FORMATTING/$formatting/;  
   
         $Str .= $tempString;  
     }  
   
     return $Str;  
 }  
   
 ########################################################  
 ########################################################  
   
 =pod  
   
 =item &FormatStudentInformation()  
   
 This function produces a formatted string of the student\'s information:  
 username, domain, section, full name, and PID.  
   
 =over 4  
   
 Input: $cache, $name, $keyID, $spacePadding  
   
 $cache: This is a pointer to a hash that is tied to the cached data  
   
 $name:  The name and domain of the current student in name:domain format  
   
 $keyID: A pointer to an array holding the names used to  
   
 remove data from the hash.  They represent the name of the data to be removed.  
   
 $spacePadding: Extra spaces that represent the space between columns  
   
 Output: $Str  
   
 $Str: Formatted string.  
   
 =back  
   
 =cut  
   
 ########################################################  
 ########################################################  
 sub FormatStudentInformation {  
     my ($data,$name,$keyID,$displayString,$format)=@_;  
     my $Str='';  
     my $currentColumn;  
   
     for(my $index=0; $index<(scalar @$keyID); $index++) {  
         $currentColumn=$data->{$name.':'.$keyID->[$index]};  
   
         if($format eq 'preformatted') {  
             my @dataLength=split(//,$currentColumn);  
             my $length=scalar @dataLength;  
             $currentColumn.= (' 'x  
                      ($data->{$keyID->[$index].':columnWidth'}-$length));  
         }  
   
         my $tempString = $displayString;  
         $tempString =~ s/DISPLAYDATA/$currentColumn/;  
   
         $Str .= $tempString;  
     }  
   
     return $Str;  
 }  
   
 ########################################################  ########################################################
 ########################################################  ########################################################
   
Line 683  Inputs Line 556  Inputs
   
 =item $number_to_do The total number of items being processed.  =item $number_to_do The total number of items being processed.
   
   =item $type Either 'popup' or 'inline' (popup is assumed if nothing is
          specified)
   
   =item $width Specify the width in charaters of the input field.
   
   =item $formname Only useful in the inline case, if a form already exists, this needs to be used and specfiy the name of the form, otherwise the Progress line will be created in a new form of it's own
   
   =item $inputname Only useful in the inline case, if a form and an input of type text exists, use this to specify the name of the input field 
   
 =back  =back
   
 Returns a hash containing the progress state data structure.  Returns a hash containing the progress state data structure.
Line 751  Returns: none Line 633  Returns: none
 ########################################################  ########################################################
 ########################################################  ########################################################
   
   my $uniq=0;
   sub get_uniq_name {
       $uniq++;
       return 'uniquename'.$uniq;
   }
   
 # Create progress  # Create progress
 sub Create_PrgWin {  sub Create_PrgWin {
     my ($r, $title, $heading, $number_to_do)=@_;      my ($r, $title, $heading, $number_to_do,$type,$width,$formname,
     $r->print('<script>'.   $inputname)=@_;
     "popwin=open(\'\',\'popwin\',\'width=400,height=100\');".      if (!defined($type)) { $type='popup'; }
     "popwin.document.writeln(\'<html><head><title>$title</title></head>".      if (!defined($width)) { $width=55; }
       my %prog_state;
       $prog_state{'type'}=$type;
       if ($type eq 'popup') {
    $prog_state{'window'}='popwin';
    #the whole function called through timeout is due to issues
    #in mozilla Read BUG #2665 if you want to know the whole story
    &r_print($r,'<script>'.
           "var popwin;
            function openpopwin () {
            popwin=open(\'\',\'popwin\',\'width=400,height=100\');".
           "popwin.document.writeln(\'<html><head><title>$title</title></head>".
       "<body bgcolor=\"#88DDFF\">".        "<body bgcolor=\"#88DDFF\">".
               "<h4>$heading</h4>".                "<h4>$heading</h4>".
               "<form name=popremain>".                "<form name=popremain>".
               '<input type="text" size="55" name="remaining" value="'.                '<input type="text" size="'.$width.'" name="remaining" value="'.
       &mt('Starting').'"></form>'.        &mt('Starting').'"></form>'.
               "</body></html>\');".                "</body></html>\');".
     "popwin.document.close();".          "popwin.document.close();}".
     "</script>");          "\nwindow.setTimeout(openpopwin,0)</script>");
    $prog_state{'formname'}='popremain';
    $prog_state{'inputname'}="remaining";
       } elsif ($type eq 'inline') {
    $prog_state{'window'}='window';
    if (!$formname) {
       $prog_state{'formname'}=&get_uniq_name();
       &r_print($r,'<form name="'.$prog_state{'formname'}.'">');
    } else {
       $prog_state{'formname'}=$formname;
    }
    if (!$inputname) {
       $prog_state{'inputname'}=&get_uniq_name();
       &r_print($r,$heading.' <input type="text" name="'.$prog_state{'inputname'}.
        '" size="'.$width.'" />');
    } else {
       $prog_state{'inputname'}=$inputname;
       
    }
    if (!$formname) { &r_print($r,'</form>'); }
    &Update_PrgWin($r,\%prog_state,&mt('Starting'));
       }
   
     my %prog_state;  
     $prog_state{'done'}=0;      $prog_state{'done'}=0;
     $prog_state{'firststart'}=&Time::HiRes::time();      $prog_state{'firststart'}=&Time::HiRes::time();
     $prog_state{'laststart'}=&Time::HiRes::time();      $prog_state{'laststart'}=&Time::HiRes::time();
     $prog_state{'max'}=$number_to_do;      $prog_state{'max'}=$number_to_do;
       
     $r->rflush();  
     return %prog_state;      return %prog_state;
 }  }
   
 # update progress  # update progress
 sub Update_PrgWin {  sub Update_PrgWin {
     my ($r,$prog_state,$displayString)=@_;      my ($r,$prog_state,$displayString)=@_;
     $r->print('<script>popwin.document.popremain.remaining.value="'.      &r_print($r,'<script>'.$$prog_state{'window'}.'.document.'.
               $displayString.'";</script>');       $$prog_state{'formname'}.'.'.
        $$prog_state{'inputname'}.'.value="'.
        $displayString.'";</script>');
     $$prog_state{'laststart'}=&Time::HiRes::time();      $$prog_state{'laststart'}=&Time::HiRes::time();
     $r->rflush();  
 }  }
   
 # increment progress state  # increment progress state
Line 830  sub Increment_PrgWin { Line 749  sub Increment_PrgWin {
     if ($user_browser eq 'explorer' && $user_os =~ 'mac') {      if ($user_browser eq 'explorer' && $user_os =~ 'mac') {
         $lasttime = '';          $lasttime = '';
     }      }
     $r->print('<script>popwin.document.popremain.remaining.value="'.      &r_print($r,'<script>'.$$prog_state{'window'}.'.document.'.
       $$prog_state{'done'}.'/'.$$prog_state{'max'}.       $$prog_state{'formname'}.'.'.
       ': '.$time_est.' '.&mt('remaining').' '.$lasttime.'";'.'</script>');       $$prog_state{'inputname'}.'.value="'.
        $$prog_state{'done'}.'/'.$$prog_state{'max'}.
        ': '.$time_est.' '.&mt('remaining').' '.$lasttime.'";'.'</script>');
     $$prog_state{'laststart'}=&Time::HiRes::time();      $$prog_state{'laststart'}=&Time::HiRes::time();
     $r->rflush();  
 }  }
   
 # close Progress Line  # close Progress Line
 sub Close_PrgWin {  sub Close_PrgWin {
     my ($r,$prog_state)=@_;      my ($r,$prog_state)=@_;
     $r->print('<script>popwin.close()</script>'."\n");      if ($$prog_state{'type'} eq 'popup') {
    &r_print($r,'<script>popwin.close()</script>'."\n");
       } elsif ($$prog_state{'type'} eq 'inline') {
    &Update_PrgWin($r,$prog_state,&mt('Done'));
       }
     undef(%$prog_state);      undef(%$prog_state);
     $r->rflush();   
 }  }
   
   sub r_print {
       my ($r,$to_print)=@_;
       if ($r) {
    $r->print($to_print);
    $r->rflush();
       } else {
    print($to_print);
       }
   }
   
 # ------------------------------------------------------- Puts directory header  # ------------------------------------------------------- Puts directory header
   
 sub crumbs {  sub crumbs {
     my ($uri,$target,$prefix)=@_;      my ($uri,$target,$prefix,$form)=@_;
     my $output='<br /><tt><b><font size="+2">'.$prefix.'/';      my $output='<br /><tt><b><font size="+2">'.$prefix.'/';
     if ($ENV{'user.adv'}) {      if ($ENV{'user.adv'}) {
  my $path=$prefix;   my $path=$prefix.'/';
  foreach (split('/',$uri)) {   foreach (split('/',$uri)) {
     unless ($_) { next; }      unless ($_) { next; }
     $path.='/'.$_;      $path.=$_;
     $output.='<a href="'.$path.'"'.($target?' target="'.$target.'"':'').'>'.$_.'</a>/';      unless ($path eq $uri) { $path.='/'; }
       my $linkpath=$path;
       if ($form) {
    $linkpath="javascript:$form.action='$path';$form.submit();";
       }
       $output.='<a href="'.$linkpath.'"'.($target?' target="'.$target.'"':'').'>'.$_.'</a>/';
  }   }
     } else {      } else {
  $output.=$uri;   $output.=$uri;
Line 865  sub crumbs { Line 802  sub crumbs {
     return $output.'</font></b></tt><br />';      return $output.'</font></b></tt><br />';
 }  }
   
   # ------------------------------------------------- Output headers for HTMLArea
   
   sub htmlareaheaders {
       unless (&htmlareabrowser()) { return ''; }
       my $lang='en';
       return (<<ENDHEADERS);
   <script type="text/javascript" src="/htmlarea/htmlarea.js"></script>
   <script type="text/javascript" src="/htmlarea/lang/$lang.js"></script>
   <script type="text/javascript" src="/htmlarea/dialog.js"></script>
   <style type="text/css">
   \@import url(/htmlarea/htmlarea.css);
   </style>
   ENDHEADERS
   }
   
   # ---------------------------------------------------------- Script to activate
   
   sub htmlareaactive {
       unless (&htmlareabrowser()) { return ''; }
       return (<<ENDSCRIPT);
   <script type="text/javascript" defer="1">
       HTMLArea.replaceAll();
   </script>
   ENDSCRIPT
   }
   
   # ---------------------------------------- Browser capable of running HTMLArea?
   
   sub htmlareabrowser {
       return 1;
   }
   
   ############################################################
   ############################################################
   
   =pod
   
   =item breadcrumbs
   
   Compiles the previously registered breadcrumbs into an series of links.
   FAQ and BUG links will be placed on the left side of the table if they
   are defined for the last registered breadcrumb.  
   Additionally supports a 'component', which will be displayed on the
   right side of the table (without a link).
   A link to help for the component will be included if one is specified.
   
   All inputs can be undef without problems.
   
   Inputs: $color (the background color of the table returned),
           $component (the large text on the right side of the table),
           $component_help
   
   Returns a string containing breadcrumbs for the current page.
   
   =item clear_breadcrumbs
   
   Clears the previously stored breadcrumbs.
   
   =item add_breadcrumb
   
   Pushes a breadcrumb on the stack of crumbs.
   
   input: $breadcrumb, a hash reference.  The keys 'href','title', and 'text'
   are required.  If present the keys 'faq' and 'bug' will be used to provide
   links to the FAQ and bug sites.
   
   returns: nothing    
   
   =cut
   
   ############################################################
   ############################################################
   {
       my @Crumbs;
   
       sub breadcrumbs {
           my ($color,$component,$component_help,$function,$domain) = @_;
           if (! defined($color)) {
               if (! defined($function)) {
                   $function = &Apache::loncommon::get_users_function();
               }
               $color = &Apache::loncommon::designparm($function.'.tabbg',
                                                       $domain);
           }
           #
           my $Str = "\n".
               '<table width="100%" border="0" cellpadding="0" cellspacing="0">'.
               '<tr><td bgcolor="'.$color.'">'.
               '<font size="-1">';
           # The last breadcrumb does not have a link, so handle it seperately.
           my $last = pop(@Crumbs);
           # The first one should be the course, I guess.
           if (exists($ENV{'request.course.id'})) {
               my $cid = $ENV{'request.course.id'};
               unshift(@Crumbs,{href=>'/adm/menu',
                                title=>'Go to main menu',
                                text=>$ENV{'course.'.$cid.'.description'},
                            });
           }
           my $links .= 
               join('-&gt;',
                    map {
                        '<a href="'.$_->{'href'}.'" title="'.$_->{'title'}.'">'.
                            $_->{'text'}.'</a>' 
                        } @Crumbs
                    );
           $links .= '-&gt;' if ($links ne '');
           $links .= '<b>'.$last->{'text'}.'</b>';
           #
           my $icons = '';
           if (exists($last->{'faq'})) {
               $icons .= &Apache::loncommon::help_open_faq($last->{'faq'});
           }
           if (exists($last->{'bug'})) {
               $icons .= &Apache::loncommon::help_open_bug($last->{'bug'});
           }
           if ($icons ne '') {
               $Str .= $icons.'&nbsp;';
           }
           #
           $Str .= $links.'</font></td>';
           #
           if (defined($component)) {
               $Str .= '<td align="right" bgcolor="'.$color.'">'.
                   '<font size="+1">'.$component.'</font>';
               if (defined($component_help)) {
                   $Str .= 
                       &Apache::loncommon::help_open_topic($component_help);
               }
               $Str.= '</td>';
           }
           $Str .= '</tr></table>'."\n";
           #
           # Return the @Crumbs stack to what we started with
           push(@Crumbs,$last);
           shift(@Crumbs);
           #
           return $Str;
       }
   
       sub clear_breadcrumbs {
           undef(@Crumbs);
       }
   
       sub add_breadcrumb {
           push (@Crumbs,@_);
       }
   
   }
   
   ############################################################
   ############################################################
   
   
 1;  1;
   
Removed from v.1.39  
changed lines
  Added in v.1.56

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