[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm

[raeburn]

raeburn		Mon Oct 14 17:14:49 2013 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - iframe src can be a dependency for an uploaded HTML page, if
    (a) path is a relative path
    (b) path is an absolute path in the same docs/<folder>/<id> subdirectory
        in the uploaded area of the current course.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1242 loncom/lonnet/perl/lonnet.pm:1.1243
--- loncom/lonnet/perl/lonnet.pm:1.1242	Sat Oct 12 01:15:38 2013
+++ loncom/lonnet/perl/lonnet.pm	Mon Oct 14 17:14:48 2013
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1242 2013/10/12 01:15:38 raeburn Exp $
+# $Id: lonnet.pm,v 1.1243 2013/10/14 17:14:48 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3502,8 +3502,26 @@
                     }
                 }
 	    }
+            if (lc($tagname) eq 'iframe') {
+                my $src = $attr->{'src'} ;
+                if (($src ne '') && ($src !~ m{^(/|https?://)})) {
+                    &add_filetype($allfiles,$src,'src');
+                } elsif ($src =~ m{^/}) {
+                    if ($env{'request.course.id'}) {
+                        my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+                        my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+                        my $url = &hreflocation('',$fullpath);
+                        if ($url =~ m{^/uploaded/$cdom/$cnum/docs/(\w+/\d+)/}) {
+                            my $relpath = $1;
+                            if ($src =~ m{^/uploaded/$cdom/$cnum/docs/\Q$relpath\E/(.+)$}) {
+                                &add_filetype($allfiles,$1,'src');
+                            }
+                        }
+                    }
+                }
+            }
             if ($t->[4] =~ m{/>$}) {
-                pop(@state);  
+                pop(@state);
             }
 	} elsif ($t->[0] eq 'E') {
 	    my ($tagname) = ($t->[1]);