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,%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: #-------------------- 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: &initdepth;
49: my $token;
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: &increasedepth();
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: $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;&decreasedepth;}
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: $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
80: \@pars,$safeeval, \%style_for_target);
81: }
82: }
83: if ($result ne "" ) {
84: if ( $#parstack > -1 ) {
85: $finaloutput .= &Apache::run::evaluate($result,$safeeval,
86: $parstack[$#parstack]);
87: } else {
88: $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
89: }
90: $result = '';
91: }
92: if ($token->[0] eq 'E') { pop @stack;pop @parstack;&decreasedepth;}
93: }
94: pop @pars;
95: }
96: return $finaloutput;
97: }
98:
99: sub recurse {
100:
101: my @innerstack = ();
102: my @innerparstack = ();
103: my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
104: my @pat = ();
105: push (@pat,HTML::TokeParser->new(\$newarg));
106: my $tokenpat;
107: my $partstring = '';
108: my $output='';
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: &increasedepth();
118: $partstring = &callsub("start_$tokenpat->[1]",
119: $target, $tokenpat, \@innerparstack,
120: \@pat, $safeeval, $style_for_target);
121: } elsif ($tokenpat->[0] eq 'E') {
122: #clear out any tags that didn't end
123: while ($tokenpat->[1] ne $innerstack[$#innerstack]
124: && ($#innerstack > -1)) {pop @innerstack;pop @innerparstack;
125: &decreasedepth;}
126: $partstring = &callsub("end_$tokenpat->[1]",
127: $target, $tokenpat, \@innerparstack,
128: \@pat, $safeeval, $style_for_target);
129: }
130: #pass both the variable to the style tag, and the tag we
131: #are processing inside the <definedtag>
132: if ( $partstring ne "" ) {
133: if ( $#parstack > -1 ) {
134: if ( $#innerparstack > -1 ) {
135: $decls= $parstack[$#parstack].$innerparstack[$#innerparstack];
136: } else {
137: $decls= $parstack[$#parstack];
138: }
139: } else {
140: if ( $#innerparstack > -1 ) {
141: $decls=$innerparstack[$#innerparstack];
142: } else {
143: $decls='';
144: }
145: }
146: $output .= &Apache::run::evaluate($partstring,$safeeval,$decls);
147: $partstring = '';
148: }
149: if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;
150: &decreasedepth;}
151: }
152: pop @pat;
153: }
154: return $output;
155: }
156:
157: sub callsub {
158: my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;
159: my $currentstring='';
160: {
161: no strict 'refs';
162: if (my $space=$Apache::lonxml::alltags{$token->[1]}) {
163: #print "Calling sub $sub in $space \n";
164: $sub="$space\:\:$sub";
165: $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
166: $currentstring = &$sub($target,$token,$parstack,$parser,
167: $safeeval,$style);
168: } else {
169: #print "NOT Calling sub $sub\n";
170: if (defined($token->[4])) {
171: $currentstring = $token->[4];
172: } else {
173: $currentstring = $token->[2];
174: }
175: }
176: use strict 'refs';
177: }
178: return $currentstring;
179: }
180:
181: sub initdepth {
182: @Apache::lonxml::depthcounter=();
183: $Apache::lonxml::depth=-1;
184: $Apache::lonxml::olddepth=-1;
185: }
186:
187: sub increasedepth {
188: if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
189: $#Apache::lonxml::depthcounter--;
190: $Apache::lonxml::olddepth=$Apache::lonxml::depth;
191: }
192: $Apache::lonxml::depth++;
193: $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;
194: if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {
195: $Apache::lonxml::olddepth=$Apache::lonxml::depth;
196: }
197: }
198:
199: sub decreasedepth {
200: $Apache::lonxml::depth--;
201: }
202:
203: sub parstring {
204: my ($token) = @_;
205: my $temp='';
206: map {$temp .= "my \$$_=\"$token->[2]->{$_}\";"} @{$token->[3]};
207: return $temp;
208: }
209: 1;
210: __END__
211:
212:
213:
214:
215:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>