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