[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Fri, 17 Jun 2005 16:53:09 -0000
albertel Fri Jun 17 12:53:09 2005 EDT
Modified files:
/loncom/lonnet/perl lonnet.pm
Log:
- Change to use pull style parser rather than the callback style
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.639 loncom/lonnet/perl/lonnet.pm:1.640
--- loncom/lonnet/perl/lonnet.pm:1.639 Fri Jun 17 12:48:13 2005
+++ loncom/lonnet/perl/lonnet.pm Fri Jun 17 12:53:07 2005
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.639 2005/06/17 16:48:13 albertel Exp $
+# $Id: lonnet.pm,v 1.640 2005/06/17 16:53:07 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1379,75 +1379,68 @@
src => '',
movie => '',
);
- my $p = HTML::Parser->new
- (
- start_h =>
- [sub {
- my ($tagname, $attr) = @_;
- push (@state, $tagname);
- if (lc($tagname) eq 'img') {
- &add_filetype($allfiles,$attr->{'src'},'src');
- }
- 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' && 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)) {
- if ($attr->{$item}) {
- &add_filetype($allfiles,$attr->{$item},$item);
- last;
- }
- }
- }
- }, "tagname, attr"],
- end_h =>
- [sub {
- my ($tagname) = @_;
- if ($javafiles{'codebase'} ne '') {
- $javafiles{'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);
- }
- }
- }
- pop @state;
- }, "tagname"],
- );
- $p->parse_file($filepath.'/'.$file);
- $p->eof;
+ my $p = HTML::LCParser->new($filepath.'/'.$file);
+ while ($t=$p->get_token()) {
+ if ($t->[0] eq 'S') {
+ my ($tagname, $attr) = ($t->[1],$t->[2]);
+ push (@state, $tagname);
+ if (lc($tagname) eq 'img') {
+ &add_filetype($allfiles,$attr->{'src'},'src');
+ }
+ 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' && 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)) {
+ if ($attr->{$item}) {
+ &add_filetype($allfiles,$attr->{$item},$item);
+ last;
+ }
+ }
+ }
+ } elsif ($t->[0] eq 'E') {
+ my ($tagname) = ($t->[1]);
+ if ($javafiles{'codebase'} ne '') {
+ $javafiles{'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);
+ }
+ }
+ }
+ pop @state;
+ }
+ }
return 'ok';
}