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

Diff for /loncom/interface/lonhtmlcommon.pm between versions 1.37 and 1.49

version 1.37, 2003/12/29 21:17:00 version 1.49, 2004/02/16 22:28:55
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;
   
Line 65  use strict; Line 66  use strict;
   
 =pod  =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
   
 =item textbox  =item textbox
   
 =cut  =cut
Line 91  sub textbox { Line 164  sub textbox {
 ##############################################  ##############################################
 ##############################################  ##############################################
 sub checkbox {  sub checkbox {
     my ($name) = @_;      my ($name,$value) = @_;
     my $Str = '<input type="checkbox" name="'.$name.'" />';      my $Str = '<input type="checkbox" name="'.$name.'"'.
    ($value?' checked="1"':'').' />';
     return $Str;      return $Str;
 }  }
   
   
   
 ##############################################  ##############################################
 ##############################################  ##############################################
   
Line 141  The method used to restrict user input w Line 213  The method used to restrict user input w
 ##############################################  ##############################################
 ##############################################  ##############################################
 sub date_setter {  sub date_setter {
     my ($formname,$dname,$currentvalue,$special) = @_;      my ($formname,$dname,$currentvalue,$special,$includeempty) = @_;
     if (! defined($currentvalue) || $currentvalue eq 'now') {      if (! defined($currentvalue) || $currentvalue eq 'now') {
         $currentvalue = time;   unless ($includeempty) {
       $currentvalue = time;
    } else {
       $currentvalue = 0;
    }
     }      }
     # other potentially useful values:     wkday,yrday,is_daylight_savings      # other potentially useful values:     wkday,yrday,is_daylight_savings
     my ($sec,$min,$hour,$mday,$month,$year,undef,undef,undef) =       my ($sec,$min,$hour,$mday,$month,$year)=('','','','','','');
         localtime($currentvalue);      if ($currentvalue) {
     $year += 1900;   ($sec,$min,$hour,$mday,$month,$year,undef,undef,undef) = 
       localtime($currentvalue);
    $year += 1900;
       }
     my $result = "\n<!-- $dname date setting form -->\n";      my $result = "\n<!-- $dname date setting form -->\n";
     $result .= <<ENDJS;      $result .= <<ENDJS;
 <script language="Javascript">  <script language="Javascript">
Line 200  ENDJS Line 279  ENDJS
                     July    August    September October November December/;                      July    August    September October November December/;
     # Pad @Months with a bogus value to make indexing easier      # Pad @Months with a bogus value to make indexing easier
     unshift(@Months,'If you can read this an error occurred');      unshift(@Months,'If you can read this an error occurred');
       if ($includeempty) { $result.="<option value=''></option>"; }
     for(my $m = 1;$m <=$#Months;$m++) {      for(my $m = 1;$m <=$#Months;$m++) {
         $result .= "      <option value=\"$m\" ";          $result .= "      <option value=\"$m\" ";
         $result .= "selected " if ($m-1 == $month);          $result .= "selected " if ($m-1 eq $month);
         $result .= "> ".&mt($Months[$m])." </option>\n";          $result .= "> ".&mt($Months[$m])." </option>\n";
     }      }
     $result .= "  </select>\n";      $result .= "  </select>\n";
Line 214  ENDJS Line 294  ENDJS
             "onChange=\"javascript:$dname\_checkday()\" />\n";              "onChange=\"javascript:$dname\_checkday()\" />\n";
     $result .= "&nbsp;&nbsp;";      $result .= "&nbsp;&nbsp;";
     $result .= "  <select name=\"$dname\_hour\" ".$special." >\n";      $result .= "  <select name=\"$dname\_hour\" ".$special." >\n";
       if ($includeempty) { $result.="<option value=''></option>"; }
     for (my $h = 0;$h<24;$h++) {      for (my $h = 0;$h<24;$h++) {
         $result .= "      <option value=\"$h\" ";          $result .= "      <option value=\"$h\" ";
         $result .= "selected " if ($hour == $h);          $result .= "selected " if ($hour == $h);
Line 445  sub StatusOptions { Line 526  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 743  Returns: none Line 627  Returns: none
   
 # 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,$formname,$inputname)=@_;
     $r->print('<script>'.      if (!defined($type)) { $type='popup'; }
     "popwin=open(\'\',\'popwin\',\'width=400,height=100\');".      my %prog_state;
     "popwin.document.writeln(\'<html><head><title>$title</title></head>".      $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="55" 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) {
       &r_print($r,'<form name="progresswindow">');
       $prog_state{'formname'}='progresswindow';
    } else {
       $prog_state{'formname'}=$formname;
    }
    if (!$inputname) {
       &r_print($r,'<input type="text" name="progressline" />');
       $prog_state{'inputname'}="progressline";
    } 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 820  sub Increment_PrgWin { Line 732  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;
Removed from v.1.37  
changed lines
  Added in v.1.49

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