--- loncom/lonnet/perl/lonnet.pm 2005/06/13 20:23:54 1.638 +++ loncom/lonnet/perl/lonnet.pm 2005/06/17 16:48:13 1.639 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.638 2005/06/13 20:23:54 albertel Exp $ +# $Id: lonnet.pm,v 1.639 2005/06/17 16:48:13 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1381,92 +1381,68 @@ sub extract_embedded_items { ); my $p = HTML::Parser->new ( - xml_mode => 1, start_h => [sub { my ($tagname, $attr) = @_; push (@state, $tagname); if (lc($tagname) eq 'img') { - if (exists($$allfiles{$attr->{'src'}})) { - unless (grep/^src$/,@{$$allfiles{$attr->{'src'}}}) { - push (@{$$allfiles{$attr->{'src'}}},&escape('src')); - } - } else { - @{$$allfiles{$attr->{'src'}}} = (&escape('src')); - } + &add_filetype($allfiles,$attr->{'src'},'src'); } - if (lc($tagname) eq 'object') { - foreach my $item (keys (%javafiles)) { + if (lc($tagname) eq 'object' || + (lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')) { + foreach my $item (keys(%javafiles)) { $javafiles{$item} = ''; } } - if (lc($state[-2]) eq 'object') { - if (lc($tagname) eq 'param') { - my $name = lc($attr->{'name'}); - foreach my $item (keys (%mediafiles)) { - if ($name eq $item) { - if (exists($$allfiles{$attr->{'value'}})) { - unless(grep/^value$/,@{$$allfiles{$attr->{'value'}}}) { - push(@{$$allfiles{$attr->{'value'}}},&escape('value')); - } - } else { - @{$$allfiles{$attr->{'value'}}} = (&escape('value')); - } - last; - } - } - foreach my $item (keys (%javafiles)) { - if ($name eq $item) { - $javafiles{$item} = $attr->{'value'}; - last; - } - } - } - } - if (lc($tagname) eq 'embed') { - unless (lc($state[-2]) eq 'object') { - foreach my $item (keys (%javafiles)) { - $javafiles{$item} = ''; - } - } - foreach my $item (keys (%javafiles)) { + if (lc($state[-2]) eq 'object' && lc($tagname) eq 'param') { + my $name = lc($attr->{'name'}); + foreach my $item (keys(%javafiles)) { + if ($name eq $item) { + $javafiles{$item} = $attr->{'value'}; + last; + } + } + foreach my $item (keys(%mediafiles)) { + if ($name eq $item) { + &add_filetype($allfiles, $attr->{'value'}, 'value'); + last; + } + } + } + if (lc($tagname) eq 'embed' || lc($tagname) eq 'applet') { + foreach my $item (keys(%javafiles)) { if ($attr->{$item}) { $javafiles{$item} = $attr->{$item}; last; } } - foreach my $item (keys (%mediafiles)) { + foreach my $item (keys(%mediafiles)) { if ($attr->{$item}) { - if (exists($$allfiles{$attr->{$item}})) { - unless (grep/^$item$/,@{$$allfiles{$item}}) { - push(@{$$allfiles{$attr->{$item}}},&escape($item)); - } - } else { - @{$$allfiles{$attr->{$item}}} = (&escape($item)); - } + &add_filetype($allfiles,$attr->{$item},$item); last; } } } }, "tagname, attr"], - text_h => - [sub { - my ($text) = @_; - }, "dtext"], end_h => [sub { my ($tagname) = @_; - unless ($javafiles{'codebase'} eq '') { + if ($javafiles{'codebase'} ne '') { $javafiles{'codebase'} .= '/'; } - if (lc($tagname) eq 'object') { - &extract_java_items(\%javafiles,$allfiles,$codebase); + if (lc($tagname) eq 'applet' || + lc($tagname) eq 'object' || + (lc($tagname) eq 'embed' && lc($state[-2]) ne 'object') + ) { + foreach my $item (keys(%javafiles)) { + if ($item ne 'codebase' && + $javafiles{$item} ne '') { + my $file=$javafiles{'codebase'}. + $javafiles{$item}; + &add_filetype($allfiles,$file,$item); + } + } } - if (lc($tagname) eq 'embed') { - unless (lc($state[-2]) eq 'object') { - &extract_java_items(\%javafiles,$allfiles,$codebase); - } - } pop @state; }, "tagname"], ); @@ -1475,22 +1451,14 @@ sub extract_embedded_items { return 'ok'; } -sub extract_java_items { - my ($javafiles,$allfiles,$codebase) = @_; - foreach my $item (keys(%{$javafiles})) { - if ($item ne 'codebase') { - if ($$javafiles{$item} ne '') { - my $file=$javafiles->{'codebase'}.$javafiles->{$item}; - if (exists($allfiles->{$file})) { - unless (scalar(grep(/^$item$/, @{$allfiles->{$file}}))) { - push(@{$allfiles->{$file}}, &escape($item)); - } - } else { - @{$allfiles->{$file}} = (&escape($item)); - $codebase->{$file} = $javafiles->{'codebase'}; - } - } - } +sub add_filetype { + my ($allfiles,$file,$type)=@_; + if (exists($allfiles->{$file})) { + unless (grep/^\Q$type\E$/, @{$allfiles->{$file}}) { + push(@{$allfiles->{$file}}, &escape($type)); + } + } else { + @{$allfiles->{$file}} = (&escape($type)); } }