Annotation of rat/lonpageflip.pm, revision 1.1
1.1 ! www 1: # The LearningOnline Network with CAPA
! 2: #
! 3: # Page flip handler
! 4: #
! 5: # (Page Handler
! 6: #
! 7: # (TeX Content Handler
! 8: #
! 9: # 05/29/00,05/30 Gerd Kortemeyer)
! 10: # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23,
! 11: # 10/02 Gerd Kortemeyer)
! 12: #
! 13: # 10/03 Gerd Kortemeyer
! 14:
! 15: package Apache::lonpageflip;
! 16:
! 17: use strict;
! 18: use Apache::Constants qw(:common :http);
! 19: use Apache::lonnet();
! 20: use HTML::TokeParser;
! 21: use GDBM_File;
! 22:
! 23: # -------------------------------------------------------------- Module Globals
! 24: my %hash;
! 25: my @rows;
! 26:
! 27: # ------------------------------------------------------------------ Euclid gcd
! 28:
! 29: sub euclid {
! 30: my ($e,$f)=@_;
! 31: my $a; my $b; my $r;
! 32: if ($e>$f) { $b=$e; $r=$f; } else { $r=$e; $b=$f; }
! 33: while ($r!=0) {
! 34: $a=$b; $b=$r;
! 35: $r=$a%$b;
! 36: }
! 37: return $b;
! 38: }
! 39:
! 40: # ------------------------------------------------------------ Build page table
! 41:
! 42: sub tracetable {
! 43: my ($sofar,$rid,$beenhere)=@_;
! 44: my $further=$sofar;
! 45: unless ($beenhere=~/\&$rid\&/) {
! 46: $beenhere.=$rid.'&';
! 47:
! 48: if (defined($hash{'is_map_'.$rid})) {
! 49: if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) &&
! 50: (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) {
! 51: my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}};
! 52: $sofar=
! 53: &tracetable($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},
! 54: '&'.$frid.'&');
! 55: $sofar++;
! 56: if ($hash{'src_'.$frid}) {
! 57: my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$frid});
! 58: if (($brepriv eq '2') || ($brepriv eq 'F')) {
! 59: if (defined($rows[$sofar])) {
! 60: $rows[$sofar].='&'.$frid;
! 61: } else {
! 62: $rows[$sofar]=$frid;
! 63: }
! 64: }
! 65: }
! 66: }
! 67: } else {
! 68: $sofar++;
! 69: if ($hash{'src_'.$rid}) {
! 70: my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$rid});
! 71: if (($brepriv eq '2') || ($brepriv eq 'F')) {
! 72: if (defined($rows[$sofar])) {
! 73: $rows[$sofar].='&'.$rid;
! 74: } else {
! 75: $rows[$sofar]=$rid;
! 76: }
! 77: }
! 78: }
! 79: }
! 80:
! 81: if (defined($hash{'to_'.$rid})) {
! 82: map {
! 83: my $now=&tracetable($sofar,$hash{'goesto_'.$_},$beenhere);
! 84: if ($now>$further) { $further=$now; }
! 85: } split(/\,/,$hash{'to_'.$rid});
! 86: }
! 87: }
! 88: return $further;
! 89: }
! 90:
! 91: # ================================================================ Main Handler
! 92:
! 93: sub handler {
! 94: my $r=shift;
! 95:
! 96: # ------------------------------------------- Set document type for header only
! 97:
! 98: # if ($r->headers_only) {
! 99: $r->content_type('text/html');
! 100: $r->send_http_header;
! 101: # return OK;
! 102: # }
! 103:
! 104:
! 105:
! 106:
! 107:
! 108: $r->print('<html><body>'.$ENV{'form.postdata'}.'</body></html>');
! 109: return OK;
! 110:
! 111:
! 112:
! 113: my $requrl=$r->uri;
! 114: # ----------------------------------------------------------------- Tie db file
! 115: if ($ENV{'request.course.fn'}) {
! 116: my $fn=$ENV{'request.course.fn'};
! 117: if (-e "$fn.db") {
! 118: if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
! 119: # ------------------------------------------------------------------- Hash tied
! 120: my $firstres=$hash{'map_start_'.$requrl};
! 121: my $lastres=$hash{'map_finish_'.$requrl};
! 122: if (($firstres) && ($lastres)) {
! 123: # ----------------------------------------------------------------- Render page
! 124:
! 125: @rows=();
! 126:
! 127: &tracetable(0,$firstres,'&'.$lastres.'&');
! 128: if ($hash{'src_'.$lastres}) {
! 129: my $brepriv=
! 130: &Apache::lonnet::allowed('bre',$hash{'src_'.$lastres});
! 131: if (($brepriv eq '2') || ($brepriv eq 'F')) {
! 132: $rows[$#rows+1]=''.$lastres;
! 133: }
! 134: }
! 135:
! 136: # ------------------------------------------------------------ Add to symb list
! 137:
! 138: my $i;
! 139: my %symbhash=();
! 140: for ($i=0;$i<=$#rows;$i++) {
! 141: if ($rows[$i]) {
! 142: my @colcont=split(/\&/,$rows[$i]);
! 143: map {
! 144: $symbhash{$hash{'src_'.$_}}='';
! 145: } @colcont;
! 146: }
! 147: }
! 148: &Apache::lonnet::symblist($requrl,%symbhash);
! 149:
! 150: # ------------------------------------------------------------------ Page parms
! 151:
! 152: my $j;
! 153: my $lcm=1;
! 154: my $contents=0;
! 155: my $nforms=0;
! 156:
! 157: my %ssibody=();
! 158: my %ssibgcolor=();
! 159: my %ssitext=();
! 160: my %ssilink=();
! 161: my %ssivlink=();
! 162: my %ssialink=();
! 163: my %cellemb=();
! 164:
! 165: my $allscript='';
! 166: my $allmeta='';
! 167:
! 168: my $isxml=0;
! 169: my $xmlheader='';
! 170: my $xmlbody='';
! 171:
! 172: # --------------------------------------------- Get SSI output, post parameters
! 173:
! 174: for ($i=0;$i<=$#rows;$i++) {
! 175: if ($rows[$i]) {
! 176: $contents++;
! 177: my @colcont=split(/\&/,$rows[$i]);
! 178: $lcm*=($#colcont+1)/euclid($lcm,($#colcont+1));
! 179: map {
! 180: my $src=$hash{'src_'.$_};
! 181: $src=~/\.(\w+)$/;
! 182: $cellemb{$_}=Apache::lonnet::fileembstyle($1);
! 183: if ($cellemb{$_} eq 'ssi') {
! 184: # --------------------------------------------------------- This is an SSI cell
! 185: my $prefix=$_.'_';
! 186: my %posthash=('request.prefix' => $prefix);
! 187: if (($ENV{'form.'.$prefix.'submit'})
! 188: || ($ENV{'form.all_submit'})) {
! 189: map {
! 190: if ($_=~/^form.$prefix/) {
! 191: my $name=$_;
! 192: $name=~s/^form.$prefix//;
! 193: $posthash{$name}=$ENV{$_};
! 194: }
! 195: } keys %ENV;
! 196: }
! 197: my $output=Apache::lonnet::ssi($src,%posthash);
! 198: my $parser=HTML::TokeParser->new(\$output);
! 199: my $token;
! 200: my $bodydef=0;
! 201: my $thisxml=0;
! 202: if ($output=~/\?xml/) {
! 203: $isxml=1;
! 204: $thisxml=1;
! 205: $output=~
! 206: /((?:\<(?:\?xml|\!DOC|html)[^\>]*(?:\>|\>\]\>)\s*)+)\<body[^\>]*\>/si;
! 207: $xmlheader=$1;
! 208: }
! 209: while (($bodydef==0) &&
! 210: ($token=$parser->get_token)) {
! 211: if ($token->[1] eq 'body') {
! 212: $bodydef=1;
! 213: $ssibgcolor{$_}=$token->[2]->{'bgcolor'};
! 214: $ssitext{$_}=$token->[2]->{'text'};
! 215: $ssilink{$_}=$token->[2]->{'link'};
! 216: $ssivlink{$_}=$token->[2]->{'vlink'};
! 217: $ssialink{$_}=$token->[2]->{'alink'};
! 218: if ($thisxml) {
! 219: $xmlbody=$token->[4];
! 220: }
! 221: }
! 222: if ($token->[1] eq 'meta') {
! 223: $allmeta.="\n".$token->[4].'</meta>';
! 224: }
! 225: if ($token->[1] eq 'script') {
! 226: $allscript.="\n\n"
! 227: .$parser->get_text('/script');
! 228: }
! 229: }
! 230: if ($output=~/\<body[^\>]*\>(.*)/si) {
! 231: $output=$1;
! 232: }
! 233: $output=~s/\<\/body\>.*//si;
! 234: if ($output=~/\<form/si) {
! 235: $nforms++;
! 236: $output=~s/\<form[^\>]*\>//gsi;
! 237: $output=~s/\<\/form[^\>]*\>//gsi;
! 238: }
! 239: $ssibody{$_}=$output;
! 240:
! 241: # ---------------------------------------------------------------- End SSI cell
! 242: }
! 243: } @colcont;
! 244: }
! 245: }
! 246: unless ($contents) {
! 247: $r->content_type('text/html');
! 248: $r->send_http_header;
! 249: $r->print('<html><body>Empty page.</body></html>');
! 250: } else {
! 251: # ------------------------------------------------------------------ Build page
! 252:
! 253: # ---------------------------------------------------------------- Send headers
! 254: if ($isxml) {
! 255: $r->content_type('text/xml');
! 256: $r->send_http_header;
! 257: $r->print($xmlheader);
! 258: } else {
! 259: $r->content_type('text/html');
! 260: $r->send_http_header;
! 261: $r->print('<html>');
! 262: }
! 263: # ------------------------------------------------------------------------ Head
! 264: $r->print("\n<head>\n".$allmeta);
! 265: if ($allscript) {
! 266: $r->print("\n<script>\n".$allscript."\n</script>\n");
! 267: }
! 268: $r->print("\n</head>\n");
! 269: # ------------------------------------------------------------------ Start body
! 270: if ($isxml) {
! 271: $r->print($xmlbody);
! 272: } else {
! 273: $r->print('<body bgcolor="#FFFFFF">');
! 274: }
! 275: # ------------------------------------------------------------------ Start form
! 276: if ($nforms) {
! 277: $r->print('<form method="post" action="'.
! 278: $requrl.'">');
! 279: }
! 280: # ----------------------------------------------------------------- Start table
! 281: $r->print('<table cols="'.$lcm.'" border="0">');
! 282: for ($i=0;$i<=$#rows;$i++) {
! 283: if ($rows[$i]) {
! 284: $r->print("\n<tr>");
! 285: my @colcont=split(/\&/,$rows[$i]);
! 286: my $avespan=$lcm/($#colcont+1);
! 287: for ($j=0;$j<=$#colcont;$j++) {
! 288: my $rid=$colcont[$j];
! 289: $r->print('<td colspan="'.$avespan.'"');
! 290: if ($cellemb{$rid} eq 'ssi') {
! 291: if ($ssibgcolor{$rid}) {
! 292: $r->print(' bgcolor="'.
! 293: $ssibgcolor{$rid}.'"');
! 294: }
! 295: $r->print('><font');
! 296: if ($ssitext{$rid}) {
! 297: $r->print(' text="'.$ssitext{$rid}.'"');
! 298: }
! 299: if ($ssilink{$rid}) {
! 300: $r->print(' link="'.$ssilink{$rid}.'"');
! 301: }
! 302: if ($ssitext{$rid}) {
! 303: $r->print(' vlink="'.$ssivlink{$rid}.'"');
! 304: }
! 305: if ($ssialink{$rid}) {
! 306: $r->print(' alink="'.$ssialink{$rid}.'"');
! 307: }
! 308:
! 309: $r->print('>'.$ssibody{$rid}.'</font>');
! 310: } elsif ($cellemb{$rid} eq 'img') {
! 311: $r->print('><img src="'.
! 312: $hash{'src_'.$rid}.'"></img>');
! 313: }
! 314: $r->print('</td>');
! 315: }
! 316: $r->print('</tr>');
! 317: }
! 318: }
! 319: $r->print("\n</table>");
! 320: # ---------------------------------------------------------------- Submit, etc.
! 321: if ($nforms) {
! 322: $r->print(
! 323: '<input name="all_submit" value="Submit All" type="'.
! 324: (($nforms>1)?'submit':'hidden').'"></input></form>');
! 325: }
! 326: $r->print('</body></html>');
! 327: # -------------------------------------------------------------------- End page
! 328: }
! 329: # ------------------------------------------------------------- End render page
! 330: } else {
! 331: $r->content_type('text/html');
! 332: $r->send_http_header;
! 333: $r->print('<html><body>Page undefined.</body></html>');
! 334: }
! 335: # ------------------------------------------------------------------ Untie hash
! 336: unless (untie(%hash)) {
! 337: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
! 338: "Could not untie coursemap $fn (browse).</font>");
! 339: }
! 340: # -------------------------------------------------------------------- All done
! 341: return OK;
! 342: # ----------------------------------------------- Errors, hash could no be tied
! 343: }
! 344: }
! 345: }
! 346: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
! 347: return HTTP_NOT_ACCEPTABLE;
! 348: }
! 349:
! 350: 1;
! 351: __END__
! 352:
! 353:
! 354:
! 355:
! 356:
! 357:
! 358:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonpageflip.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / rat