File:
[LON-CAPA] /
loncom /
xml /
lonxml.pm
Revision
1.22:
download - view:
text,
annotated -
select for diffs
Mon Oct 2 22:19:19 2000 UTC (23 years, 9 months ago) by
albertel
Branches:
MAIN
CVS tags:
HEAD
- added debug,error, and warning functions
- they don't do much right now but eventually
- debug won't do anything
- error will provide error messages, if a student is using it it might just
supress the actual message but send an email to the creator of the
resource, if it is in an editing mode, it will give the user the error
message and were it occured
- warning will be supressed when a student is using it, but will look like
errors when an instructor is editing
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: &Apache::lonxml::debug("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: &Apache::lonxml::debug("NOT Calling sub $sub in $space<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:
245: $Apache::lonxml::debug=0;
246: sub debug {
247: if ($Apache::lonxml::debug eq 1) {
248: print "DEBUG:".$_[0]."<br>\n";
249: }
250: }
251: sub error {
252: if ($Apache::lonxml::debug eq 1) {
253: print "ERROR:".$_[0]."<br>\n";
254: }
255: }
256: sub warning {
257: if ($Apache::lonxml::debug eq 1) {
258: print "WARNING:".$_[0]."<br>\n";
259: }
260: }
261:
262: 1;
263: __END__
264:
265:
266:
267:
268:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>