[BACK]Return to lonpage.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / rat

Diff for /rat/lonpage.pm between versions 1.10 and 1.35

version 1.10, 2000/10/02 21:33:40 version 1.35, 2002/03/26 23:12:57
Line 1 Line 1
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # Page Handler  # Page Handler
 #  #
   # $Id$
   #
   # Copyright Michigan State University Board of Trustees
   #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   #
   # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
   #
   # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
   #
   # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   #
   # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
   #
 # (TeX Content Handler  # (TeX Content Handler
 #  #
   # YEAR=2000
 # 05/29/00,05/30 Gerd Kortemeyer)  # 05/29/00,05/30 Gerd Kortemeyer)
 # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23,  # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23,
 # 10/02 Gerd Kortemeyer  # 10/02,10/10,10/14,10/16,10/18,10/19,10/31,11/6,11/14,11/16,
   # YEAR=2001
   # 08/13/01,08/30,10/1 Gerd Kortemeyer
   # 12/16 Scott Harrison
   # YEAR=2002
   # 03/19 Gerd Kortemeyer
   #
   ###
   
 package Apache::lonpage;  package Apache::lonpage;
   
 use strict;  use strict;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
 use Apache::lonnet();  use Apache::lonnet();
   use Apache::loncommon();
   use Apache::lonxml();
 use HTML::TokeParser;  use HTML::TokeParser;
 use GDBM_File;  use GDBM_File;
   
Line 74  sub tracetable { Line 108  sub tracetable {
        }         }
   
        if (defined($hash{'to_'.$rid})) {         if (defined($hash{'to_'.$rid})) {
           map {    my $mincond=1;
               my $now=&tracetable($sofar,$hash{'goesto_'.$_},$beenhere);            my $next='';
               if ($now>$further) { $further=$now; }            foreach (split(/\,/,$hash{'to_'.$rid})) {
           } split(/\,/,$hash{'to_'.$rid});                my $thiscond=
         &Apache::lonnet::directcondval($hash{'condid_'.$hash{'undercond_'.$_}});
                 if ($thiscond>=$mincond) {
     if ($next) {
         $next.=','.$_.':'.$thiscond;
                     } else {
                         $next=$_.':'.$thiscond;
     }
                     if ($thiscond>$mincond) { $mincond=$thiscond; }
         }
             }
             foreach (split(/\,/,$next)) {
                 my ($linkid,$condval)=split(/\:/,$_);
                 if ($condval>=$mincond) {
                   my $now=&tracetable($sofar,$hash{'goesto_'.$linkid},$beenhere);
                   if ($now>$further) { $further=$now; }
         }
             }
   
        }         }
     }      }
     return $further;      return $further;
Line 130  sub handler { Line 182  sub handler {
                   for ($i=0;$i<=$#rows;$i++) {                    for ($i=0;$i<=$#rows;$i++) {
      if ($rows[$i]) {       if ($rows[$i]) {
                         my @colcont=split(/\&/,$rows[$i]);                          my @colcont=split(/\&/,$rows[$i]);
                         map {                          foreach (@colcont) {
                            $symbhash{$hash{'src_'.$_}}='';                             $symbhash{$hash{'src_'.$_}}='';
         } @colcont;          }
      }       }
   }    }
                   &Apache::lonnet::symblist($requrl,%symbhash);                    &Apache::lonnet::symblist($requrl,%symbhash);
Line 150  sub handler { Line 202  sub handler {
                   my %ssilink=();                    my %ssilink=();
                   my %ssivlink=();                    my %ssivlink=();
                   my %ssialink=();                    my %ssialink=();
        
                     my %metalink=();
   
                   my %cellemb=();                    my %cellemb=();
   
                   my $allscript='';                    my $allscript='';
Line 166  sub handler { Line 221  sub handler {
       $contents++;        $contents++;
                       my @colcont=split(/\&/,$rows[$i]);                        my @colcont=split(/\&/,$rows[$i]);
                       $lcm*=($#colcont+1)/euclid($lcm,($#colcont+1));                        $lcm*=($#colcont+1)/euclid($lcm,($#colcont+1));
                       map {                        foreach (@colcont) {
                           my $src=$hash{'src_'.$_};                            my $src=$hash{'src_'.$_};
                           $src=~/\.(\w+)$/;                            $src=~/\.(\w+)$/;
                           $cellemb{$_}=Apache::lonnet::fileembstyle($1);                            $metalink{$_}=$src.'.meta';
                             $cellemb{$_}=Apache::loncommon::fileembstyle($1);
                           if ($cellemb{$_} eq 'ssi') {                            if ($cellemb{$_} eq 'ssi') {
 # --------------------------------------------------------- This is an SSI cell  # --------------------------------------------------------- This is an SSI cell
       my $prefix=$_.'_';        my $prefix=$_.'_';
                               my %posthash=('request.prefix' => $prefix);                                my %posthash=('request.prefix' => $prefix);
                               if (($ENV{'form.'.$prefix.'submit'})                                 if (($ENV{'form.'.$prefix.'submit'}) 
                                || ($ENV{'form.all_submit'})) {                                 || ($ENV{'form.all_submit'})) {
                                map {                                 foreach (keys %ENV) {
   if ($_=~/^form.$prefix/) {    if ($_=~/^form.$prefix/) {
       my $name=$_;        my $name=$_;
                                       $name=~s/^form.$prefix//;                                        $name=~s/^form.$prefix//;
                                       $posthash{$name}=$ENV{$_};                                        $posthash{$name}=$ENV{$_};
                                   }                                    }
                                } keys %ENV;                                 }
       }        }
                               my $output=Apache::lonnet::ssi($src,%posthash);                                my $output=Apache::lonnet::ssi($src,%posthash);
                               my $parser=HTML::TokeParser->new(\$output);                                my $parser=HTML::TokeParser->new(\$output);
                               my $token;                                my $token;
                                 my $thisdir=$src;
                               my $bodydef=0;                                my $bodydef=0;
                               my $thisxml=0;                                my $thisxml=0;
                                 my @rlinks=();
                               if ($output=~/\?xml/) {                                if ($output=~/\?xml/) {
                                  $isxml=1;                                   $isxml=1;
                                  $thisxml=1;                                   $thisxml=1;
Line 196  sub handler { Line 254  sub handler {
          /((?:\<(?:\?xml|\!DOC|html)[^\>]*(?:\>|\>\]\>)\s*)+)\<body[^\>]*\>/si;           /((?:\<(?:\?xml|\!DOC|html)[^\>]*(?:\>|\>\]\>)\s*)+)\<body[^\>]*\>/si;
                                  $xmlheader=$1;                                   $xmlheader=$1;
       }        }
                               while (($bodydef==0) &&                                while ($token=$parser->get_token) {
                                      ($token=$parser->get_token)) {   if ($token->[0] eq 'S') {
   if ($token->[1] eq 'body') {                                    if ($token->[1] eq 'a') {
         if ($token->[2]->{'href'}) {
                                            $rlinks[$#rlinks+1]=
        $token->[2]->{'href'};
         }
     } elsif ($token->[1] eq 'img') {
                                            $rlinks[$#rlinks+1]=
        $token->[2]->{'src'};
     } elsif ($token->[1] eq 'embed') {
                                            $rlinks[$#rlinks+1]=
        $token->[2]->{'src'};
     } elsif ($token->[1] eq 'base') {
         $thisdir=$token->[2]->{'href'};
     } elsif ($token->[1] eq 'body') {
       $bodydef=1;        $bodydef=1;
                                       $ssibgcolor{$_}=$token->[2]->{'bgcolor'};                                        $ssibgcolor{$_}=$token->[2]->{'bgcolor'};
                                       $ssitext{$_}=$token->[2]->{'text'};                                        $ssitext{$_}=$token->[2]->{'text'};
Line 208  sub handler { Line 279  sub handler {
                                       if ($thisxml) {                                        if ($thisxml) {
   $xmlbody=$token->[4];    $xmlbody=$token->[4];
                                       }                                        }
                                   }                                    } elsif ($token->[1] eq 'meta') {
                                   if ($token->[1] eq 'meta') {      if ($token->[4] !~ m:/>$:) {
       $allmeta.="\n".$token->[4].'</meta>';        $allmeta.="\n".$token->[4].'</meta>';
                                   }      } else {
                                   if ($token->[1] eq 'script') {        $allmeta.="\n".$token->[4];
       }
                                     } elsif (($token->[1] eq 'script') &&
                                              ($bodydef==0)) {
       $allscript.="\n\n"        $allscript.="\n\n"
                                                 .$parser->get_text('/script');                                                  .$parser->get_text('/script');
                                   }                                    }
                               }          }
         }
                               if ($output=~/\<body[^\>]*\>(.*)/si) {                                if ($output=~/\<body[^\>]*\>(.*)/si) {
                                  $output=$1;                                    $output=$1; 
                               }                                }
Line 225  sub handler { Line 300  sub handler {
   $nforms++;    $nforms++;
                                   $output=~s/\<form[^\>]*\>//gsi;                                    $output=~s/\<form[^\>]*\>//gsi;
                                   $output=~s/\<\/form[^\>]*\>//gsi;                                    $output=~s/\<\/form[^\>]*\>//gsi;
                                     $output=~
         s/\<((?:input|select|button|textarea)[^\>]+)name\s*\=\s*[\'\"]*([\w\.\:]+)[\'\"]*([^\>]*)\>/\<$1 name="$prefix$2" $3\>/gsi;
                               }                                }
                                 $thisdir=~s/\/[^\/]*$//;
         foreach (@rlinks) {
     unless (($_=~/^http:\/\//i) ||
     ($_=~/^\//) ||
     ($_=~/^javascript:/i) ||
     ($_=~/^mailto:/i) ||
     ($_=~/^\#/)) {
         my $newlocation=
       &Apache::lonnet::hreflocation($thisdir,$_);
                        $output=~s/(\"|\'|\=\s*)$_(\"|\'|\s|\>)/$1$newlocation$2/;
     }
         }
   # -------------------------------------------------- Deal with Applet codebases
     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
       $ssibody{$_}=$output;        $ssibody{$_}=$output;
   
 # ---------------------------------------------------------------- End SSI cell  # ---------------------------------------------------------------- End SSI cell
                           }                            }
                       } @colcont;                        }
                      }                        } 
                   }                    }
                   unless ($contents) {                    unless ($contents) {
Line 252  sub handler { Line 342  sub handler {
       }        }
 # ------------------------------------------------------------------------ Head  # ------------------------------------------------------------------------ Head
                       $r->print("\n<head>\n".$allmeta);                        $r->print("\n<head>\n".$allmeta);
                         $allscript=~
          s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs;
                       if ($allscript) {                        if ($allscript) {
   $r->print("\n<script>\n".$allscript."\n</script>\n");    $r->print("\n<script language='JavaScript'>\n".
                                      $allscript."\n</script>\n");
                       }                        }
                         $r->print(&Apache::lonxml::registerurl(1,undef));
                       $r->print("\n</head>\n");                        $r->print("\n</head>\n");
 # ------------------------------------------------------------------ Start body  # ------------------------------------------------------------------ Start body
                       if ($isxml) {                        if ($isxml) {
                           $r->print($xmlbody);                            $r->print($xmlbody);
                       } else {                        } else {
   $r->print('<body bgcolor="#FFFFFF">');    $r->print(
    '<body bgcolor="#FFFFFF" onLoad="'.&Apache::lonxml::loadevents.
                        '" onUnload="'.&Apache::lonxml::unloadevents.'">');
                       }                        }
 # ------------------------------------------------------------------ Start form  # ------------------------------------------------------------------ Start form
                       if ($nforms) {                        if ($nforms) {
Line 276  sub handler { Line 372  sub handler {
                           my $avespan=$lcm/($#colcont+1);                            my $avespan=$lcm/($#colcont+1);
                           for ($j=0;$j<=$#colcont;$j++) {                            for ($j=0;$j<=$#colcont;$j++) {
                               my $rid=$colcont[$j];                                my $rid=$colcont[$j];
                                 my $metainfo='<a href="'.
                                       $metalink{$rid}.'" target="LONcatInfo">'.
                             '<img src="/adm/lonMisc/cat_button.gif" border=0>'.
     '</img></a><a href="/adm/evaluate?postdata='.
         &Apache::lonnet::escape(&Apache::lonnet::declutter($hash{'src_'.$rid}))
         .'" target="LONcatInfo">'.
                             '<img src="/adm/lonMisc/eval_button.gif" border=0>'.
                             '</img></a>';
                                 if (
    ($hash{'src_'.$rid}=~/\.(problem|exam|quiz|assess|survey|form)$/) &&
    (&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}))) {
     my ($mapid,$resid)=split(/\./,$rid);
                                    my $symb=
                   &Apache::lonnet::declutter($hash{'map_id_'.$mapid}).
                   '___'.$resid.'___'.
    &Apache::lonnet::declutter($hash{'src_'.$rid});
                                    $metainfo.=
                     '<a href="/adm/grades?symb='.$symb.
                     '&command=submission" target="LONcatInfo">'.
                             '<img src="/adm/lonMisc/subm_button.gif" border=0>'.
     '</img></a>'.
                     '<a href="/adm/grades?symb='.$symb.
                     '&command=viewgrades" target="LONcatInfo">'.
                             '<img src="/adm/lonMisc/pgrd_button.gif" border=0>'.
     '</img></a>'.
                     '<a href="/adm/parmset?symb='.$symb.'" target="LONcatInfo">'.
                             '<img src="/adm/lonMisc/pprm_button.gif" border=0>'.
         '</img></a>';
                                 }
                                 $metainfo.='<br></br>';
                               $r->print('<td colspan="'.$avespan.'"');                                $r->print('<td colspan="'.$avespan.'"');
                               if ($cellemb{$rid} eq 'ssi') {                                if ($cellemb{$rid} eq 'ssi') {
   if ($ssibgcolor{$rid}) {    if ($ssibgcolor{$rid}) {
                                      $r->print(' bgcolor="'.                                       $r->print(' bgcolor="'.
                                                $ssibgcolor{$rid}.'"');                                                 $ssibgcolor{$rid}.'"');
                                   }                                    }
                                   $r->print('><font');                                    $r->print('>'.$metainfo.'<font');
                                   if ($ssitext{$rid}) {                                    if ($ssitext{$rid}) {
      $r->print(' text="'.$ssitext{$rid}.'"');       $r->print(' text="'.$ssitext{$rid}.'"');
                                   }                                    }
Line 298  sub handler { Line 424  sub handler {
                                                           
                                   $r->print('>'.$ssibody{$rid}.'</font>');                                    $r->print('>'.$ssibody{$rid}.'</font>');
                               } elsif ($cellemb{$rid} eq 'img') {                                } elsif ($cellemb{$rid} eq 'img') {
                                   $r->print('><img src="'.                                    $r->print('>'.$metainfo.'<img src="'.
                                     $hash{'src_'.$rid}.'"></img>');                                      $hash{'src_'.$rid}.'"></img>');
       }        } elsif ($cellemb{$rid} eq 'emb') {
                                     $r->print('>'.$metainfo.'<embed src="'.
                                       $hash{'src_'.$rid}.'"></embed>');
                                 }
                               $r->print('</td>');                                $r->print('</td>');
                           }                            }
                           $r->print('</tr>');                            $r->print('</tr>');
Line 313  sub handler { Line 442  sub handler {
                   '<input name="all_submit" value="Submit All" type="'.                    '<input name="all_submit" value="Submit All" type="'.
   (($nforms>1)?'submit':'hidden').'"></input></form>');    (($nforms>1)?'submit':'hidden').'"></input></form>');
                       }                        }
                       $r->print('</body></html>');                        $r->print('</body>'.&Apache::lonxml::xmlend());
 # -------------------------------------------------------------------- End page  # -------------------------------------------------------------------- End page
                   }                                      }                  
 # ------------------------------------------------------------- End render page  # ------------------------------------------------------------- End render page
Line 340  sub handler { Line 469  sub handler {
 1;  1;
 __END__  __END__
   
   =head1 NAME
   
   Apache::lonpage - Page Handler
   
   =head1 SYNOPSIS
   
   Invoked by /etc/httpd/conf/srm.conf:
   
    <LocationMatch "^/res/.*\.page$>
    SetHandler perl-script
    PerlHandler Apache::lonpage
    </LocationMatch>
   
   =head1 INTRODUCTION
   
   This module renders a .page resource.
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   =head1 HANDLER SUBROUTINE
   
   This routine is called by Apache and mod_perl.
   
   =over 4
   
   =item *
   
   set document type for header only
   
   =item *
   
   tie db file
   
   =item *
   
   render page
   
   =item *
   
   add to symb list
   
   =item *
   
   page parms
   
   =item *
   
   Get SSI output, post parameters
   
   =item *
   
   SSI cell rendering
   
   =item *
   
   Deal with Applet codebases
   
   =item *
   
   Build page
   
   =item *
   
   send headers
   
   =item *
   
   start body
   
   =item *
   
   start form
   
   =item *
   
   start table
   
   =item *
   
   submit element, etc, render page, untie hash
   
   =back
   
   =head1 OTHER SUBROUTINES
   
   =over 4
   
   =item *
   
   euclid() : Euclid's method for determining the greatest common denominator.
   
   =item *
   
   tracetable() : Build page table.
   
   =back
   
   =cut
   
   
   
Removed from v.1.10  
changed lines
  Added in v.1.35

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