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:
12: sub register {
13: my $space;
14: my @taglist;
15: my $temptag;
16: ($space,@taglist) = @_;
17: foreach $temptag (@taglist) {
18: $Apache::lonxml::alltags{$temptag}=$space;
19: }
20: }
21:
22: use Apache::style;
23: use Apache::lontexconvert;
24: use Apache::run;
25: use Apache::londefdef;
26: use Apache::scripttag;
27: #================================================== Main subroutine: xmlparse
28:
29: sub xmlparse {
30:
31: my ($target,$content_file_string,%style_for_target) = @_;
32: my $pars = HTML::TokeParser->new(\$content_file_string);
33: my $currentstring = '';
34: my $finaloutput = '';
35: my $newarg = '';
36: my $safeeval = new Safe;
37: $safeeval->permit("entereval");
38: #-------------------- Redefinition of the target in the case of compound target
39:
40: ($target, my @tenta) = split('&&',$target);
41:
42: #------------------------- Stack definition (in stack we have all current tags)
43:
44: my @stack = ();
45: my @parstack = ();
46:
47: #------------------------------------- Parse input string (content_file_string)
48:
49: my $token;
50:
51: while ($token = $pars->get_token) {
52: if ($token->[0] eq 'T') {
53: $finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,'');
54: } elsif ($token->[0] eq 'S') {
55: # add tag to stack
56: push (@stack,$token->[1]);
57: # add parameters list to another stack
58: push (@parstack,&parstring($token));
59:
60: if (exists $style_for_target{$token->[1]}) {
61: #basically recurse, but we never got more than one level down so just
62: #create the new context here
63: my @innerstack = ();
64: my @innerparstack = ();
65: # use style file definition
66: $newarg = $style_for_target{$token->[1]};
67: my $pat = HTML::TokeParser->new(\$newarg);
68: my $tokenpat = '';
69: my $partstring = '';
70:
71: while ($tokenpat = $pat->get_token) {
72: if ($tokenpat->[0] eq 'T') {
73: $partstring = $tokenpat->[1];
74: } elsif ($tokenpat->[0] eq 'S') {
75: push (@innerstack,$tokenpat->[1]);
76: push (@innerparstack,&parstring($tokenpat));
77: $partstring = &callsub("start_$tokenpat->[1]",
78: $target, $tokenpat, \@innerparstack)
79: } elsif ($tokenpat->[0] eq 'E') {
80: #clear out any tags that didn't end
81: while ($tokenpat->[1] ne $innerstack[$#innerstack]
82: && ($#innerstack > 0)) {pop @innerstack;pop @innerparstack;}
83: $partstring = &callsub("end_$tokenpat->[1]",
84: $target, $tokenpat, \@innerparstack)
85: }
86: #pass both the variable to the style tag, and the tag we
87: #are processing inside the <definedtag>
88: $finaloutput .= &Apache::run::evaluate($partstring,$safeeval,
89: $parstack[$#parstack].$innerparstack[$#innerparstack]);
90: if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; }
91: }
92: } else {
93: my $result = &callsub("start_$token->[1]", $target, $token, \@parstack);
94: $finaloutput .= &Apache::run::evaluate($result,$safeeval,
95: $parstack[$#parstack]);
96: }
97: } elsif ($token->[0] eq 'E') {
98: #clear out any tags that didn't end
99: while ($token->[1] ne $stack[$#stack]
100: && ($#stack > 0)) {pop @stack;pop @parstack;}
101:
102: if (exists $style_for_target{'/'."$token->[1]"}) {
103: my @innerstack = ();
104: my @innerparstack = ();
105: $newarg = $style_for_target{'/'."$token->[1]"};
106: my $pat = HTML::TokeParser->new(\$newarg);
107: my $tokenpat;
108: my $partstring = '';
109:
110: while ($tokenpat = $pat->get_token) {
111: if ($tokenpat->[0] eq 'T') {
112: $partstring .= $tokenpat->[1];
113: } elsif ($tokenpat->[0] eq 'S') {
114: push (@innerstack,$tokenpat->[1]);
115: push (@innerparstack,&parstring($tokenpat));
116: $partstring = &callsub("start_$tokenpat->[1]",
117: $target, $tokenpat, \@innerparstack)
118: } elsif ($tokenpat->[0] eq 'E') {
119: #clear out any tags that didn't end
120: while ($tokenpat->[1] ne $innerstack[$#innerstack]
121: && ($#innerstack > 0)) {pop @innerstack;pop @innerparstack;}
122: $partstring = &callsub("end_$tokenpat->[1]",
123: $target, $tokenpat, \@innerparstack)
124: }
125: #pass both the variable to the style tag, and the tag we
126: #are processing inside the <definedtag>
127: $finaloutput .= &Apache::run::evaluate($partstring,$safeeval,
128: $parstack[$#parstack].$innerparstack[$#innerparstack]);
129: if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; }
130: }
131: } else {
132: my $result = &callsub("start_$token->[1]", $target, $token, \@parstack);
133: $finaloutput .= &Apache::run::evaluate($result,$safeeval,
134: $parstack[$#parstack]);
135: }
136: pop @stack;
137: pop @parstack;
138: }
139: }
140: return $finaloutput;
141: }
142:
143: sub callsub {
144: my ($sub,$target,$token,@parstack)=@_;
145: my $currentstring='';
146: {
147: no strict 'refs';
148: if (my $space=$Apache::lonxml::alltags{$token->[1]}) {
149: #print "Calling sub $sub in $space \n";
150: $sub="$space\:\:$sub";
151: $currentstring = &$sub($target,$token,\@parstack);
152: } else {
153: #print "NOT Calling sub $sub\n";
154: if (defined($token->[4])) {
155: $currentstring = $token->[4];
156: } else {
157: $currentstring = $token->[2];
158: }
159: }
160: use strict 'refs';
161: }
162: return $currentstring;
163: }
164:
165: sub parstring {
166: my ($token) = @_;
167: my $temp='';
168: map {$temp .= "my \$$_=\"$token->[2]->{$_}\";"} @{$token->[3]};
169: return $temp;
170: }
171: 1;
172: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>