File:
[LON-CAPA] /
loncom /
xml /
lonxml.pm
Revision
1.21:
download - view:
text,
annotated -
select for diffs
Tue Sep 19 19:10:01 2000 UTC (23 years, 8 months ago) by
albertel
Branches:
MAIN
CVS tags:
HEAD
- moved $external::target to always be defined
- fixed scripttag to allow it be able to report results from scripts
- fixed caparesponse to not print out anything
1: # The LearningOnline Network with CAPA
2: # XML Parser Module
3: #
4: # last modified 06/26/00 by Alexander Sakharuk
5:
6: package Apache::lonxml;
7:
8: use strict;
9: use HTML::TokeParser;
10: use Safe;
11: use Opcode;
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: }
22:
23: use Apache::style;
24: use Apache::lontexconvert;
25: use Apache::run;
26: use Apache::londefdef;
27: use Apache::scripttag;
28: #================================================== Main subroutine: xmlparse
29:
30: sub xmlparse {
31:
32: my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
33: my @pars = ();
34: push (@pars,HTML::TokeParser->new(\$content_file_string));
35: my $currentstring = '';
36: my $finaloutput = '';
37: my $newarg = '';
38: my $result;
39: my $safeeval = new Safe;
40: $safeeval->permit("entereval");
41: $safeeval->permit(":base_math");
42: $safeeval->deny(":base_io");
43: #need to inspect this class of ops
44: # $safeeval->deny(":base_orig");
45: $safeinit .= ';$external::target='.$target.';';
46: &Apache::run::run($safeinit,$safeeval);
47: #-------------------- Redefinition of the target in the case of compound target
48:
49: ($target, my @tenta) = split('&&',$target);
50:
51: my @stack = ();
52: my @parstack = ();
53: &initdepth;
54: my $token;
55: while ( $#pars > -1 ) {
56: while ($token = $pars[$#pars]->get_token) {
57: if ($token->[0] eq 'T') {
58: $result=$token->[1];
59: # $finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,'');
60: } elsif ($token->[0] eq 'S') {
61: # add tag to stack
62: push (@stack,$token->[1]);
63: # add parameters list to another stack
64: push (@parstack,&parstring($token));
65: &increasedepth($token);
66: if (exists $style_for_target{$token->[1]}) {
67: $finaloutput .= &recurse($style_for_target{$token->[1]},
68: $target,$safeeval,\%style_for_target,
69: @parstack);
70: } else {
71: $result = &callsub("start_$token->[1]", $target, $token,\@parstack,
72: \@pars, $safeeval, \%style_for_target);
73: }
74: } elsif ($token->[0] eq 'E') {
75: #clear out any tags that didn't end
76: while ($token->[1] ne $stack[$#stack]
77: && ($#stack > -1)) {pop @stack;pop @parstack;&decreasedepth($token);}
78:
79: if (exists $style_for_target{'/'."$token->[1]"}) {
80: $finaloutput .= &recurse($style_for_target{'/'."$token->[1]"},
81: $target,$safeeval,\%style_for_target,
82: @parstack);
83: } else {
84: $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
85: \@pars,$safeeval, \%style_for_target);
86: }
87: }
88: if ($result ne "" ) {
89: if ( $#parstack > -1 ) {
90: $finaloutput .= &Apache::run::evaluate($result,$safeeval,
91: $parstack[$#parstack]);
92: } else {
93: $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
94: }
95: $result = '';
96: }
97: if ($token->[0] eq 'E') { pop @stack;pop @parstack;&decreasedepth($token);}
98: }
99: pop @pars;
100: }
101: return $finaloutput;
102: }
103:
104: sub recurse {
105:
106: my @innerstack = ();
107: my @innerparstack = ();
108: my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
109: my @pat = ();
110: push (@pat,HTML::TokeParser->new(\$newarg));
111: my $tokenpat;
112: my $partstring = '';
113: my $output='';
114: my $decls='';
115: while ( $#pat > -1 ) {
116: while ($tokenpat = $pat[$#pat]->get_token) {
117: if ($tokenpat->[0] eq 'T') {
118: $partstring = $tokenpat->[1];
119: } elsif ($tokenpat->[0] eq 'S') {
120: push (@innerstack,$tokenpat->[1]);
121: push (@innerparstack,&parstring($tokenpat));
122: &increasedepth($tokenpat);
123: $partstring = &callsub("start_$tokenpat->[1]",
124: $target, $tokenpat, \@innerparstack,
125: \@pat, $safeeval, $style_for_target);
126: } elsif ($tokenpat->[0] eq 'E') {
127: #clear out any tags that didn't end
128: while ($tokenpat->[1] ne $innerstack[$#innerstack]
129: && ($#innerstack > -1)) {pop @innerstack;pop @innerparstack;
130: &decreasedepth($tokenpat);}
131: $partstring = &callsub("end_$tokenpat->[1]",
132: $target, $tokenpat, \@innerparstack,
133: \@pat, $safeeval, $style_for_target);
134: }
135: #pass both the variable to the style tag, and the tag we
136: #are processing inside the <definedtag>
137: if ( $partstring ne "" ) {
138: if ( $#parstack > -1 ) {
139: if ( $#innerparstack > -1 ) {
140: $decls= $parstack[$#parstack].$innerparstack[$#innerparstack];
141: } else {
142: $decls= $parstack[$#parstack];
143: }
144: } else {
145: if ( $#innerparstack > -1 ) {
146: $decls=$innerparstack[$#innerparstack];
147: } else {
148: $decls='';
149: }
150: }
151: $output .= &Apache::run::evaluate($partstring,$safeeval,$decls);
152: $partstring = '';
153: }
154: if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;
155: &decreasedepth($tokenpat);}
156: }
157: pop @pat;
158: }
159: return $output;
160: }
161:
162: sub callsub {
163: my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;
164: my $currentstring='';
165: {
166: no strict 'refs';
167: if (my $space=$Apache::lonxml::alltags{$token->[1]}) {
168: #print "Calling sub $sub in $space<br>\n";
169: $sub="$space\:\:$sub";
170: $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
171: $currentstring = &$sub($target,$token,$parstack,$parser,
172: $safeeval,$style);
173: } else {
174: #print "NOT Calling sub $sub<br>\n";
175: if (defined($token->[4])) {
176: $currentstring = $token->[4];
177: } else {
178: $currentstring = $token->[2];
179: }
180: }
181: use strict 'refs';
182: }
183: return $currentstring;
184: }
185:
186: sub initdepth {
187: @Apache::lonxml::depthcounter=();
188: $Apache::lonxml::depth=-1;
189: $Apache::lonxml::olddepth=-1;
190: }
191:
192: sub increasedepth {
193: my ($token) = @_;
194: if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
195: $#Apache::lonxml::depthcounter--;
196: $Apache::lonxml::olddepth=$Apache::lonxml::depth;
197: }
198: $Apache::lonxml::depth++;
199: # print "<br>s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1]<br>\n";
200: $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;
201: if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {
202: $Apache::lonxml::olddepth=$Apache::lonxml::depth;
203: }
204: }
205:
206: sub decreasedepth {
207: my ($token) = @_;
208: $Apache::lonxml::depth--;
209: # print "<br>e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1]<br>\n";
210: }
211:
212: sub get_all_text {
213:
214: my($tag,$pars)= @_;
215: my $depth=0;
216: my $token;
217: my $result='';
218: while (($depth >=0) && ($token = $pars->get_token)) {
219: if ($token->[0] eq 'T') {
220: $result.=$token->[1];
221: } elsif ($token->[0] eq 'S') {
222: if ($token->[1] eq $tag) { $depth++; }
223: $result.=$token->[4];
224: } elsif ($token->[0] eq 'E') {
225: if ($token->[1] eq $tag) { $depth--; }
226: #skip sending back the last end tag
227: if ($depth > -1) { $result.=$token->[2]; }
228: }
229: }
230: return $result
231: }
232:
233:
234: sub parstring {
235: my ($token) = @_;
236: my $temp='';
237: map {
238: if ($_=~/\w+/) {
239: $temp .= "my \$$_=\"$token->[2]->{$_}\";"
240: }
241: } @{$token->[3]};
242: return $temp;
243: }
244: 1;
245: __END__
246:
247:
248:
249:
250:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>