[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Fri, 17 Jun 2005 16:48:16 -0000
albertel Fri Jun 17 12:48:16 2005 EDT
Modified files:
/loncom/lonnet/perl lonnet.pm
Log:
- trying to er clean the code?
- added support for <applet>
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.638 loncom/lonnet/perl/lonnet.pm:1.639
--- loncom/lonnet/perl/lonnet.pm:1.638 Mon Jun 13 16:23:54 2005
+++ loncom/lonnet/perl/lonnet.pm Fri Jun 17 12:48:13 2005
@@ -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 @@
);
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 @@
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));
}
}