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 = HTML::TokeParser->new(\$content_file_string);
34: my $currentstring = '';
35: my $finaloutput = '';
36: my $newarg = '';
37: my $safeeval = new Safe;
38: $safeeval->permit("entereval");
39: $safeeval->permit(":base_math");
40: #-------------------- Redefinition of the target in the case of compound target
41:
42: ($target, my @tenta) = split('&&',$target);
43:
44: #------------------------- Stack definition (in stack we have all current tags)
45:
46: my @stack = ();
47: my @parstack = ();
48:
49: #------------------------------------- Parse input string (content_file_string)
50:
51: my $token;
52:
53: while ($token = $pars->get_token) {
54: if ($token->[0] eq 'T') {
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:
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: my $result = &callsub("start_$token->[1]", $target, $token,\@parstack,
68: $pars, $safeeval, \%style_for_target);
69: if ($result ne "" ) {
70: $finaloutput .= &Apache::run::evaluate($result,$safeeval,
71: $parstack[$#parstack]);
72: }
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 > 0)) {pop @stack;pop @parstack;}
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: my $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
85: $pars,$safeeval, \%style_for_target);
86: if ($result ne "") {
87: $finaloutput .= &Apache::run::evaluate($result,$safeeval,
88: $parstack[$#parstack]);
89: }
90: }
91: pop @stack;
92: pop @parstack;
93: }
94: }
95: return $finaloutput;
96: }
97:
98: sub recurse {
99:
100: my @innerstack = ();
101: my @innerparstack = ();
102: my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
103: my $pat = HTML::TokeParser->new(\$newarg);
104: my $tokenpat;
105: my $partstring = '';
106: my $output='';
107: while ($tokenpat = $pat->get_token) {
108: if ($tokenpat->[0] eq 'T') {
109: $partstring = $tokenpat->[1];
110: } elsif ($tokenpat->[0] eq 'S') {
111: push (@innerstack,$tokenpat->[1]);
112: push (@innerparstack,&parstring($tokenpat));
113: $partstring = &callsub("start_$tokenpat->[1]",
114: $target, $tokenpat, \@innerparstack,
115: $pat, $safeeval, $style_for_target);
116: } elsif ($tokenpat->[0] eq 'E') {
117: #clear out any tags that didn't end
118: while ($tokenpat->[1] ne $innerstack[$#innerstack]
119: && ($#innerstack > 0)) {pop @innerstack;pop @innerparstack;}
120: $partstring = &callsub("end_$tokenpat->[1]",
121: $target, $tokenpat, \@innerparstack,
122: $pat, $safeeval, $style_for_target);
123: }
124: #pass both the variable to the style tag, and the tag we
125: #are processing inside the <definedtag>
126: if ( $partstring ne "" ) {
127: $output .= &Apache::run::evaluate($partstring,$safeeval,
128: $parstack[$#parstack].$innerparstack[$#innerparstack]);
129: }
130: if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; }
131: }
132: return $output;
133: }
134:
135: sub callsub {
136: my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;
137: my $currentstring='';
138: {
139: no strict 'refs';
140: if (my $space=$Apache::lonxml::alltags{$token->[1]}) {
141: #print "Calling sub $sub in $space \n";
142: $sub="$space\:\:$sub";
143: $currentstring = &$sub($target,$token,\@$parstack,$parser,$safeeval,$style);
144: } else {
145: #print "NOT Calling sub $sub\n";
146: if (defined($token->[4])) {
147: $currentstring = $token->[4];
148: } else {
149: $currentstring = $token->[2];
150: }
151: }
152: use strict 'refs';
153: }
154: return $currentstring;
155: }
156:
157: sub parstring {
158: my ($token) = @_;
159: my $temp='';
160: map {$temp .= "my \$$_=\"$token->[2]->{$_}\";"} @{$token->[3]};
161: return $temp;
162: }
163: 1;
164: __END__
165:
166:
167:
168:
169:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>