[LON-CAPA-cvs] cvs: loncom /interface loncommon.pm

[albertel]

albertel		Tue Jun 24 18:16:32 2003 EDT

  Modified files:              
    /loncom/interface	loncommon.pm 
  Log:
  - created a 'realtive to absolute links' post processing function to update link info to be absolute
  - get_student_view uses new relative_to_absolute
  - BUG#1812, relative links when tryng to view SUBM or grade by page now show up.
  
  
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.106 loncom/interface/loncommon.pm:1.107
--- loncom/interface/loncommon.pm:1.106	Fri Jun 20 10:44:06 2003
+++ loncom/interface/loncommon.pm	Tue Jun 24 18:16:32 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.106 2003/06/20 14:44:06 bowersj2 Exp $
+# $Id: loncommon.pm,v 1.107 2003/06/24 22:16:32 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1511,6 +1511,41 @@
   }
 }
 
+sub relative_to_absolute {
+    my ($url,$output)=@_;
+    my $parser=HTML::TokeParser->new(\$output);
+    my $token;
+    my $thisdir=$url;
+    my @rlinks=();
+    while ($token=$parser->get_token) {
+	if ($token->[0] eq 'S') {
+	    if ($token->[1] eq 'a') {
+		if ($token->[2]->{'href'}) {
+		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
+		}
+	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
+		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
+	    } elsif ($token->[1] eq 'base') {
+		$thisdir=$token->[2]->{'href'};
+	    }
+	}
+    }
+    $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;
+    return $output;
+}
+
 sub get_student_view {
   my ($symb,$username,$domain,$courseid,$target) = @_;
   my ($map,$id,$feedurl) = split(/___/,$symb);
@@ -1522,7 +1557,8 @@
   }
   if ($target eq 'tex') {$moreenv{'form.grade_target'} = 'tex';}
   &Apache::lonnet::appenv(%moreenv);
-  my $userview=&Apache::lonnet::ssi_body(&Apache::lonnet::clutter($feedurl));
+  $feedurl=&Apache::lonnet::clutter($feedurl);
+  my $userview=&Apache::lonnet::ssi_body($feedurl);
   &Apache::lonnet::delenv('form.grade_');
   foreach my $element (@elements) {
     $ENV{'form.grade_'.$element}=$old{$element};
@@ -1534,6 +1570,7 @@
   $userview=~s/\<head\>//gi;
   $userview=~s/\<\/head\>//gi;
   $userview=~s/action\s*\=/would_be_action\=/gi;
+  $userview=&relative_to_absolute($feedurl,$userview);
   return $userview;
 }