Annotation of loncom/xml/lonxml.pm, revision 1.16
1.2 sakharuk 1: # The LearningOnline Network with CAPA
1.3 sakharuk 2: # XML Parser Module
1.2 sakharuk 3: #
1.3 sakharuk 4: # last modified 06/26/00 by Alexander Sakharuk
1.2 sakharuk 5:
1.4 albertel 6: package Apache::lonxml;
1.1 sakharuk 7:
8: use strict;
9: use HTML::TokeParser;
1.3 sakharuk 10: use Safe;
1.13 albertel 11: use Opcode;
1.7 albertel 12:
13: sub register {
14: my $space;
15: my @taglist;
16: my $temptag;
17: ($space,@taglist) = @_;
18: foreach $temptag (@taglist) {
19: $Apache::lonxml::alltags{$temptag}=$space;
20: }
21: }
1.11 sakharuk 22:
1.4 albertel 23: use Apache::style;
1.3 sakharuk 24: use Apache::lontexconvert;
1.7 albertel 25: use Apache::run;
1.4 albertel 26: use Apache::londefdef;
1.7 albertel 27: use Apache::scripttag;
1.3 sakharuk 28: #================================================== Main subroutine: xmlparse
29:
30: sub xmlparse {
31:
32: my ($target,$content_file_string,%style_for_target) = @_;
1.16 ! albertel 33: my @pars = ();
! 34: push (@pars,HTML::TokeParser->new(\$content_file_string));
1.3 sakharuk 35: my $currentstring = '';
36: my $finaloutput = '';
37: my $newarg = '';
1.16 ! albertel 38: my $result;
1.3 sakharuk 39: my $safeeval = new Safe;
1.6 albertel 40: $safeeval->permit("entereval");
1.13 albertel 41: $safeeval->permit(":base_math");
1.3 sakharuk 42: #-------------------- Redefinition of the target in the case of compound target
43:
44: ($target, my @tenta) = split('&&',$target);
45:
46: my @stack = ();
47: my @parstack = ();
48: my $token;
1.16 ! albertel 49: print $#pars;
! 50: while ( $#pars > -1 ) {
! 51: while ($token = $pars[$#pars]->get_token) {
! 52: if ($token->[0] eq 'T') {
! 53: $result=$token->[1];
! 54: # $finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,'');
! 55: } elsif ($token->[0] eq 'S') {
! 56: # add tag to stack
! 57: push (@stack,$token->[1]);
! 58: # add parameters list to another stack
! 59: push (@parstack,&parstring($token));
! 60:
! 61: if (exists $style_for_target{$token->[1]}) {
! 62: $finaloutput .= &recurse($style_for_target{$token->[1]},
! 63: $target,$safeeval,\%style_for_target,
! 64: @parstack);
! 65: } else {
! 66: my $result = &callsub("start_$token->[1]", $target, $token,\@parstack,
! 67: \@pars, $safeeval, \%style_for_target);
! 68: }
! 69: } elsif ($token->[0] eq 'E') {
! 70: #clear out any tags that didn't end
! 71: while ($token->[1] ne $stack[$#stack]
! 72: && ($#stack > -1)) {pop @stack;pop @parstack;}
! 73:
! 74: if (exists $style_for_target{'/'."$token->[1]"}) {
! 75: $finaloutput .= &recurse($style_for_target{'/'."$token->[1]"},
! 76: $target,$safeeval,\%style_for_target,
! 77: @parstack);
! 78: } else {
! 79: my $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
! 80: \@pars,$safeeval, \%style_for_target);
1.13 albertel 81: }
1.16 ! albertel 82: }
! 83: if ($result ne "" ) {
! 84: if ( $#parstack > -1 ) {
1.13 albertel 85: $finaloutput .= &Apache::run::evaluate($result,$safeeval,
86: $parstack[$#parstack]);
1.16 ! albertel 87: } else {
! 88: $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
1.13 albertel 89: }
1.16 ! albertel 90: $result = '';
1.2 sakharuk 91: }
1.16 ! albertel 92: if ($token->[0] eq 'E') { pop @stack;pop @parstack; }
1.5 albertel 93: }
1.16 ! albertel 94: pop @pars;
1.3 sakharuk 95: }
96: return $finaloutput;
1.15 albertel 97: }
98:
99: sub recurse {
100:
101: my @innerstack = ();
102: my @innerparstack = ();
103: my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
1.16 ! albertel 104: my @pat = ();
! 105: push (@pat,HTML::TokeParser->new(\$newarg));
1.15 albertel 106: my $tokenpat;
107: my $partstring = '';
108: my $output='';
1.16 ! albertel 109: my $decls='';
! 110: while ( $#pat > -1 ) {
! 111: while ($tokenpat = $pat[$#pat]->get_token) {
! 112: if ($tokenpat->[0] eq 'T') {
! 113: $partstring = $tokenpat->[1];
! 114: } elsif ($tokenpat->[0] eq 'S') {
! 115: push (@innerstack,$tokenpat->[1]);
! 116: push (@innerparstack,&parstring($tokenpat));
! 117: $partstring = &callsub("start_$tokenpat->[1]",
! 118: $target, $tokenpat, \@innerparstack,
! 119: \@pat, $safeeval, $style_for_target);
! 120: } elsif ($tokenpat->[0] eq 'E') {
! 121: #clear out any tags that didn't end
! 122: while ($tokenpat->[1] ne $innerstack[$#innerstack]
! 123: && ($#innerstack > -1)) {pop @innerstack;pop @innerparstack;}
! 124: $partstring = &callsub("end_$tokenpat->[1]",
! 125: $target, $tokenpat, \@innerparstack,
! 126: \@pat, $safeeval, $style_for_target);
! 127: }
! 128: #pass both the variable to the style tag, and the tag we
! 129: #are processing inside the <definedtag>
! 130: if ( $partstring ne "" ) {
! 131: if ( $#parstack > -1 ) {
! 132: if ( $#innerparstack > -1 ) {
! 133: $decls= $parstack[$#parstack].$innerparstack[$#innerparstack];
! 134: } else {
! 135: $decls= $parstack[$#parstack];
! 136: }
! 137: } else {
! 138: if ( $#innerparstack > -1 ) {
! 139: $decls=$innerparstack[$#innerparstack];
! 140: } else {
! 141: $decls='';
! 142: }
! 143: }
! 144: $output .= &Apache::run::evaluate($partstring,$safeeval,$decls);
! 145: $partstring = '';
! 146: }
! 147: if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; }
1.15 albertel 148: }
1.16 ! albertel 149: pop @pat;
1.15 albertel 150: }
151: return $output;
1.7 albertel 152: }
153:
154: sub callsub {
1.14 albertel 155: my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;
1.7 albertel 156: my $currentstring='';
157: {
158: no strict 'refs';
159: if (my $space=$Apache::lonxml::alltags{$token->[1]}) {
160: #print "Calling sub $sub in $space \n";
161: $sub="$space\:\:$sub";
1.16 ! albertel 162: $currentstring = &$sub($target,$token,$parstack,$parser,
! 163: $safeeval,$style);
1.7 albertel 164: } else {
1.12 sakharuk 165: #print "NOT Calling sub $sub\n";
1.7 albertel 166: if (defined($token->[4])) {
167: $currentstring = $token->[4];
168: } else {
169: $currentstring = $token->[2];
170: }
171: }
172: use strict 'refs';
173: }
174: return $currentstring;
1.1 sakharuk 175: }
176:
1.8 albertel 177: sub parstring {
178: my ($token) = @_;
179: my $temp='';
180: map {$temp .= "my \$$_=\"$token->[2]->{$_}\";"} @{$token->[3]};
181: return $temp;
182: }
1.1 sakharuk 183: 1;
184: __END__
1.11 sakharuk 185:
186:
187:
188:
189:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonxml.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / xml