Diff for /loncom/interface/loncommon.pm between versions 1.309 and 1.331

version 1.309, 2006/03/16 21:23:51 version 1.331, 2006/04/11 20:00:44
Line 58  use strict; Line 58  use strict;
 use Apache::lonnet;  use Apache::lonnet;
 use GDBM_File;  use GDBM_File;
 use POSIX qw(strftime mktime);  use POSIX qw(strftime mktime);
 use Apache::Constants qw(:common :http :methods);  
 use Apache::lonmenu();  use Apache::lonmenu();
 use Apache::lonlocal;  use Apache::lonlocal;
 use HTML::Entities;  use HTML::Entities;
Line 721  sub help_open_menu { Line 720  sub help_open_menu {
   "<td bgcolor='#CC6600'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";    "<td bgcolor='#CC6600'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
     }      }
     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();      my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
     my $html=&Apache::lonxml::xmlbegin();  
     my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");      my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");
       my $start_page =
           &Apache::loncommon::start_page('Help Menu', undef,
          {'frameset'    => 1,
    'js_ready'    => 1,
    'add_entries' => {
       'border' => '0',
       'rows'   => "105,*",},});
       my $end_page =
           &Apache::loncommon::end_page({'frameset' => 1,
         'js_ready' => 1,});
   
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
  <script type="text/javascript">   <script type="text/javascript">
 // <!-- BEGIN LON-CAPA Internal  // <!-- BEGIN LON-CAPA Internal
Line 746  function helpMenu(target) { Line 755  function helpMenu(target) {
     return;      return;
 }  }
 function writeHelp(caller) {  function writeHelp(caller) {
     caller.document.writeln('$html<head><title>LON-CAPA Help Menu</title><meta http-equiv="pragma" content="no-cache"></head>')      caller.document.writeln('$start_page<frame name="bannerframe"  src="$banner_link" /><frame name="bodyframe" src="$details_link" /> $end_page')
     caller.document.writeln("<frameset rows='105,*' border='0'><frame name='bannerframe'  src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")  
     caller.document.writeln("</html>")  
     caller.document.close()      caller.document.close()
     caller.focus()      caller.focus()
 }  }
Line 2737  Inputs: Line 2744  Inputs:
 =item * $forcereg, if page should register as content page (relevant for   =item * $forcereg, if page should register as content page (relevant for 
             text interface only)              text interface only)
   
 =item * $customtitle, overrides the $title in some way ????  =item * $customtitle, alternate text to use instead of $title
                         in the title box that appears, this text
                         is not auto translated like the $title is
   
 =item * $notopbar, if true, keep the 'what is this' info but remove the  =item * $notopbar, if true, keep the 'what is this' info but remove the
                    navigational links                     navigational links
   
   =item * $bgcolor, used to override the bg coor on a webpage to a specific value
   
 =back  =back
   
 Returns: A uniform header for LON-CAPA web pages.    Returns: A uniform header for LON-CAPA web pages.  
Line 2752  other decorations will be returned. Line 2764  other decorations will be returned.
   
 sub bodytag {  sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,      my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
  $notopbar)=@_;   $notopbar,$bgcolor)=@_;
     $title=&mt($title);      $title=&mt($title);
     $function = &get_users_function() if (!$function);      $function = &get_users_function() if (!$function);
     my $img=&designparm($function.'.img',$domain);      my $img=&designparm($function.'.img',$domain);
     my $pgbg=&designparm($function.'.pgbg',$domain);      my $pgbg= $bgcolor || &designparm($function.'.pgbg',$domain);
     my $tabbg=&designparm($function.'.tabbg',$domain);      my $tabbg=&designparm($function.'.tabbg',$domain);
     my $font=&designparm($function.'.font',$domain);      my $font=&designparm($function.'.font',$domain);
     my $link=&designparm($function.'.link',$domain);      my $link=&designparm($function.'.link',$domain);
Line 2764  sub bodytag { Line 2776  sub bodytag {
     my $vlink=&designparm($function.'.vlink',$domain);      my $vlink=&designparm($function.'.vlink',$domain);
     my $sidebg=&designparm($function.'.sidebg',$domain);      my $sidebg=&designparm($function.'.sidebg',$domain);
 # Accessibility font enhance  # Accessibility font enhance
     unless ($addentries) { $addentries=''; }  
     my $addstyle='';      my $addstyle='';
     if ($env{'browser.fontenhance'} eq 'on') {      if ($env{'browser.fontenhance'} eq 'on') {
  $addstyle=' font-size: x-large;';   $addstyle=' font-size: x-large;';
Line 2783  sub bodytag { Line 2794  sub bodytag {
 # Port for miniserver  # Port for miniserver
     my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};      my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
     if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }      if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
   
       my $extra_body_attr = &make_attr_string($forcereg,$addentries);
   
 # construct main body tag  # construct main body tag
     my $bodytag = <<END;      my $bodytag = <<END;
 <style type="text/css">  <style type="text/css">
Line 2795  form, .inline { display: inline; } Line 2809  form, .inline { display: inline; }
 .filename {font-family: monospace;}  .filename {font-family: monospace;}
 </style>  </style>
 <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"  <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
 style="margin-top: 0px;$addstyle" $addentries>  style="margin-top: 0px;$addstyle" $extra_body_attr>
 END  END
     &Apache::lontexconvert::jsMath_reset();  
     if ($env{'environment.texengine'} eq 'jsMath') {      $bodytag .= &Apache::lontexconvert::init_math_support();
  $bodytag.=&Apache::lontexconvert::jsMath_header();  
     }  
   
     my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.      my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
                    $lonhttpdPort.$img.'" alt="'.$function.'" />';                     $lonhttpdPort.$img.'" alt="'.$function.'" />';
Line 2929  $titleinfo $dc_info $menu Line 2941  $titleinfo $dc_info $menu
 ENDBODY  ENDBODY
 }  }
   
   sub make_attr_string {
       my ($register,$attr_ref) = @_;
   
       if ($attr_ref && !ref($attr_ref)) {
    die("addentries Must be a hash ref ".
       join(':',caller(1))." ".
       join(':',caller(0))." ");
       }
   
       if ($register) {
    $attr_ref->{'onload'}   = &Apache::lonmenu::loadevents().
       $attr_ref->{'onload'};
    $attr_ref->{'onunload'} = &Apache::lonmenu::unloadevents().
       $attr_ref->{'onunload'};
       }
       my $attr_string;
       foreach my $attr (keys(%$attr_ref)) {
    $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
       }
       return $attr_string;
   }
   
   
 ###############################################  ###############################################
 ###############################################  ###############################################
   
Line 2953  Inputs: none Line 2988  Inputs: none
 sub endbodytag {  sub endbodytag {
     my $endbodytag='</body>';      my $endbodytag='</body>';
     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;      $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
       if ( exists( $env{'internal.head.redirect'} ) ) {
    $endbodytag=
       "<br /><a href=\"$env{'internal.head.redirect'}\">".
       &mt('Continue').'</a>'.
       $endbodytag;
       }
     return $endbodytag;      return $endbodytag;
 }  }
   
Line 2966  Returns a uniform footer for LON-CAPA we Line 3007  Returns a uniform footer for LON-CAPA we
   
 Inputs: $title - optional title for the head  Inputs: $title - optional title for the head
         $head_extra - optional extra HTML to put inside the <head>          $head_extra - optional extra HTML to put inside the <head>
           $args - optional arguments
               force_register - if is true call registerurl so the remote is 
                                informed
                                
               redirect - array ref of seconds before redirect occurs
                                       url to redirect to
                              (side effect of setting 
                                  $env{'internal.head.redirect'} to the url 
                                  redirected too)
 =back  =back
   
 =cut  =cut
   
 sub headtag {  sub headtag {
     my ($title,$head_extra) = @_;      my ($title,$head_extra,$args) = @_;
           
     my $result =      my $result =
  '<head>'.   '<head>'.
  &Apache::lonxml::fontsettings().   &Apache::lonxml::fontsettings().
  &Apache::lonhtmlcommon::htmlareaheaders();   &Apache::lonhtmlcommon::htmlareaheaders();
       
       if ($args->{'force_register'}) {
    $result .= &Apache::lonmenu::registerurl(1);
       }
   
       if (ref($args->{'redirect'})) {
    my ($time,$url) = @{$args->{'redirect'}};
    $url = &Apache::lonenc::check_encrypt($url);
    $env{'internal.head.redirect'} = $url;
    $result.=<<ADDMETA
   <meta http-equiv="pragma" content="no-cache" />
   <meta HTTP-EQUIV="Refresh" CONTENT="$time; url=$url" />
   ADDMETA
       }
     if (!defined($title)) {      if (!defined($title)) {
  $title = 'The LearningOnline Network with CAPA';   $title = 'The LearningOnline Network with CAPA';
     }      }
           
     $result .= '<title>'.&mt($title).'</title>'.$head_extra;      $result .= '<title> LON-CAPA '.&mt($title).'</title>'.$head_extra;
       
     return $result;      return $result;
 }  }
   
Line 3021  Inputs: $title - optional title for the Line 3082  Inputs: $title - optional title for the
 =cut  =cut
   
 sub head {  sub head {
     my ($title,$head_extra) = @_;      my ($title,$head_extra,$args) = @_;
     return &headtag($title,$head_extra).&endheadtag();      return &headtag($title,$head_extra,$args).&endheadtag();
 }  }
   
 =pod  =pod
Line 3035  Returns a complete <html> .. <body> sect Line 3096  Returns a complete <html> .. <body> sect
   
 Inputs: $title - optional title for the page  Inputs: $title - optional title for the page
         $head_extra - optional extra HTML to incude inside the <head>          $head_extra - optional extra HTML to incude inside the <head>
         %args - additional optional args supported are:          $args - additional optional args supported are:
                   onlybody -> is true will set &bodytag() onlybodytag arg on                    only_body      -> is true will set &bodytag() onlybodytag
                   notopbar -> is true will set &bodytag() notopbar arg on                                      arg on
                     no_nav_bar     -> is true will set &bodytag() notopbar arg on
                     add_entries    -> additional attributes to add to the  <body>
                     domain         -> force to color decorate a page for a 
                                       specific domain
                     function       -> force usage of a specific rolish color
                                       scheme
                     redirect       -> see &headtag()
                     bgcolor        -> override the default page bg color
                     js_ready       -> return a string ready for being used in 
                                       a javascript writeln
                     html_encode    -> return a string ready for being used in 
                                       a html attribute
                     force_register -> if is true will turn on the &bodytag()
                                       $forcereg arg
                     body_title     -> alternate text to use instead of $title
                                       in the title box that appears, this text
                                       is not auto translated like the $title is
                     frameset       -> if true will start with a <frameset>
                                       rather than <body>
 =back  =back
   
 =cut  =cut
   
 sub start_page {  sub start_page {
     my ($title,$head_extra,$args) = @_;      my ($title,$head_extra,$args) = @_;
     return       #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
       my %head_args;
       foreach my $arg ('redirect','force_register') {
    if (defined($args->{$arg})) {
       $head_args{$arg} = $args->{$arg};
    }
       }
   
       $env{'internal.start_page'}++;
       my $result = 
  &Apache::lonxml::xmlbegin().   &Apache::lonxml::xmlbegin().
  &headtag($title,$head_extra).&endheadtag().   &headtag($title,$head_extra,\%head_args).&endheadtag();
  &bodytag($title,undef,undef,$args->{'onlybody'},undef,undef,undef,      if ($args->{'frameset'}) {
  $args->{'notopbar'});   my $attr_string = &make_attr_string($args->{'force_register'},
       $args->{'add_entries'});
    $result .= "\n<frameset $attr_string>\n";
       } else {
    $result .=
       &bodytag($title, 
        $args->{'function'},       $args->{'add_entries'},
        $args->{'only_body'},      $args->{'domain'},
        $args->{'force_register'}, $args->{'body_title'},
        $args->{'no_nav_bar'},     $args->{'bgcolor'});
       }
       if ($args->{'js_ready'}) {
    $result = &js_ready($result);
       }
       if ($args->{'html_encode'}) {
    $result = &html_encode($result);
       }
       return $result;
 }  }
   
   
 =pod  =pod
   
 =over 4  =over 4
Line 3060  sub start_page { Line 3166  sub start_page {
   
 Returns a complete </body></html> section for LON-CAPA web pages.  Returns a complete </body></html> section for LON-CAPA web pages.
   
 Inputs: None  Inputs:         $args - additional optional args supported are:
                    js_ready     -> return a string ready for being used in 
                                    a javascript writeln
                    html_encode  -> return a string ready for being used in 
                                    a html attribute
                    frameset     -> if true will start with a <frameset>
                                    rather than <body>
 =back  =back
   
 =cut  =cut
   
 sub end_page {  sub end_page {
     return &endbodytag."\n</html>";      my ($args) = @_;
       #&Apache::lonnet::logthis("end_page ".join(':',caller(0)));
       $env{'internal.end_page'}++;
       my $result;
       if ($args->{'frameset'}) {
    $result .= '</frameset>';
       } else {
    $result .= &endbodytag();
       }
       $result .= "\n</html>";
   
       if ($args->{'js_ready'}) {
    $result = &js_ready($result);
       }
       if ($args->{'html_encode'}) {
    $result = &html_encode($result);
       }
       return $result;
   }
   
   sub html_encode {
       my ($result) = @_;
   
       $result = &HTML::Entities::encode($result,'<>&"');
       
       return $result;
   }
   sub js_ready {
       my ($result) = @_;
   
       $result =~ s/[\n\r]/ /xmsg;
       $result =~ s/\\/\\\\/xmsg;
       $result =~ s/'/\\'/xmsg;
       $result =~ s{</script>}{</scrip'+'t>}xmsg;
       
       return $result;
   }
   
   sub validate_page {
       if (  exists($env{'internal.start_page'})
     &&     $env{'internal.start_page'} > 1) {
    &Apache::lonnet::logthis('start_page called multiple times '.
    $env{'internal.start_page'}.' '.
    $ENV{'request.filename'});
       }
       if (  exists($env{'internal.end_page'})
     &&     $env{'internal.end_page'} > 1) {
    &Apache::lonnet::logthis('end_page called multiple times '.
    $env{'internal.end_page'}.' '.
    $env{'request.filename'});
       }
       if (     exists($env{'internal.start_page'})
    && ! exists($env{'internal.end_page'})) {
    &Apache::lonnet::logthis('start_page called without end_page '.
    $env{'request.filename'});
       }
       if (   ! exists($env{'internal.start_page'})
    &&   exists($env{'internal.end_page'})) {
    &Apache::lonnet::logthis('end_page called without start_page'.
    $env{'request.filename'});
       }
   }
   
   sub simple_error_page {
       my ($r,$title,$msg) = @_;
       my $page =
    &Apache::loncommon::start_page($title).
    &mt($msg).
    &Apache::loncommon::end_page();
       if (ref($r)) {
    $r->print($page);
    return;
       }
       return $page;
 }  }
 ###############################################  ###############################################
   
Line 3553  sub get_posted_cgi { Line 3737  sub get_posted_cgi {
     }      }
  }   }
     }      }
   #
   # Digested POSTed values
   #
   # Remember the way this was originally done (GET or POST)
   #
     $env{'request.method'}=$ENV{'REQUEST_METHOD'};      $env{'request.method'}=$ENV{'REQUEST_METHOD'};
     $r->method_number(M_GET);  #
   # There may also be stuff in the query string
   # Tell subsequent handlers that this was GET, not POST, so they can access query string.
   # Also, unset POSTed content length to cover all tracks.
   #
   
   # This does not work, because M_GET is not defined (if it's defined, it is just 0). 
   # Commenting out for now ... not sure if harm is done.
   #    $r->method_number(M_GET);
   
     $r->method('GET');      $r->method('GET');
     $r->headers_in->unset('Content-length');      $r->headers_in->unset('Content-length');
 }  }

Removed from v.1.309  
changed lines
  Added in v.1.331


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