Annotation of loncom/xml/lonxml.pm, revision 1.22
1.2 sakharuk 1: # The LearningOnline Network with CAPA
1.3 sakharuk 2: # XML Parser Module
1.2 sakharuk 3: #
1.3 sakharuk 4: # last modified 06/26/00 by Alexander Sakharuk
1.2 sakharuk 5:
1.4 albertel 6: package Apache::lonxml;
1.1 sakharuk 7:
8: use strict;
9: use HTML::TokeParser;
1.3 sakharuk 10: use Safe;
1.13 albertel 11: use Opcode;
1.7 albertel 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: }
1.11 sakharuk 22:
1.4 albertel 23: use Apache::style;
1.3 sakharuk 24: use Apache::lontexconvert;
1.7 albertel 25: use Apache::run;
1.4 albertel 26: use Apache::londefdef;
1.7 albertel 27: use Apache::scripttag;
1.3 sakharuk 28: #================================================== Main subroutine: xmlparse
29:
30: sub xmlparse {
31:
1.18 albertel 32: my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
1.16 albertel 33: my @pars = ();
34: push (@pars,HTML::TokeParser->new(\$content_file_string));
1.3 sakharuk 35: my $currentstring = '';
36: my $finaloutput = '';
37: my $newarg = '';
1.16 albertel 38: my $result;
1.3 sakharuk 39: my $safeeval = new Safe;
1.6 albertel 40: $safeeval->permit("entereval");
1.13 albertel 41: $safeeval->permit(":base_math");
1.19 albertel 42: $safeeval->deny(":base_io");
43: #need to inspect this class of ops
44: # $safeeval->deny(":base_orig");
1.21 albertel 45: $safeinit .= ';$external::target='.$target.';';
46: &Apache::run::run($safeinit,$safeeval);
1.3 sakharuk 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 = ();
1.17 albertel 53: &initdepth;
1.3 sakharuk 54: my $token;
1.16 albertel 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));
1.19 albertel 65: &increasedepth($token);
1.16 albertel 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 {
1.17 albertel 71: $result = &callsub("start_$token->[1]", $target, $token,\@parstack,
1.16 albertel 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]
1.19 albertel 77: && ($#stack > -1)) {pop @stack;pop @parstack;&decreasedepth($token);}
1.16 albertel 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 {
1.17 albertel 84: $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
1.16 albertel 85: \@pars,$safeeval, \%style_for_target);
1.13 albertel 86: }
1.16 albertel 87: }
88: if ($result ne "" ) {
89: if ( $#parstack > -1 ) {
1.13 albertel 90: $finaloutput .= &Apache::run::evaluate($result,$safeeval,
91: $parstack[$#parstack]);
1.16 albertel 92: } else {
93: $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
1.13 albertel 94: }
1.16 albertel 95: $result = '';
1.2 sakharuk 96: }
1.19 albertel 97: if ($token->[0] eq 'E') { pop @stack;pop @parstack;&decreasedepth($token);}
1.5 albertel 98: }
1.16 albertel 99: pop @pars;
1.3 sakharuk 100: }
101: return $finaloutput;
1.15 albertel 102: }
103:
104: sub recurse {
105:
106: my @innerstack = ();
107: my @innerparstack = ();
108: my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
1.16 albertel 109: my @pat = ();
110: push (@pat,HTML::TokeParser->new(\$newarg));
1.15 albertel 111: my $tokenpat;
112: my $partstring = '';
113: my $output='';
1.16 albertel 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));
1.19 albertel 122: &increasedepth($tokenpat);
1.16 albertel 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]
1.17 albertel 129: && ($#innerstack > -1)) {pop @innerstack;pop @innerparstack;
1.19 albertel 130: &decreasedepth($tokenpat);}
1.16 albertel 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: }
1.17 albertel 154: if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;
1.19 albertel 155: &decreasedepth($tokenpat);}
1.15 albertel 156: }
1.16 albertel 157: pop @pat;
1.15 albertel 158: }
159: return $output;
1.7 albertel 160: }
161:
162: sub callsub {
1.14 albertel 163: my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;
1.7 albertel 164: my $currentstring='';
165: {
166: no strict 'refs';
167: if (my $space=$Apache::lonxml::alltags{$token->[1]}) {
1.22 ! albertel 168: &Apache::lonxml::debug("Calling sub $sub in $space<br>\n");
1.7 albertel 169: $sub="$space\:\:$sub";
1.17 albertel 170: $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
1.16 albertel 171: $currentstring = &$sub($target,$token,$parstack,$parser,
172: $safeeval,$style);
1.7 albertel 173: } else {
1.22 ! albertel 174: &Apache::lonxml::debug("NOT Calling sub $sub in $space<br>\n");
1.7 albertel 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;
1.17 albertel 184: }
185:
186: sub initdepth {
187: @Apache::lonxml::depthcounter=();
188: $Apache::lonxml::depth=-1;
189: $Apache::lonxml::olddepth=-1;
190: }
191:
192: sub increasedepth {
1.19 albertel 193: my ($token) = @_;
1.17 albertel 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++;
1.19 albertel 199: # print "<br>s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1]<br>\n";
1.17 albertel 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 {
1.19 albertel 207: my ($token) = @_;
1.17 albertel 208: $Apache::lonxml::depth--;
1.19 albertel 209: # print "<br>e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1]<br>\n";
1.1 sakharuk 210: }
1.19 albertel 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:
1.1 sakharuk 233:
1.8 albertel 234: sub parstring {
235: my ($token) = @_;
236: my $temp='';
1.20 albertel 237: map {
238: if ($_=~/\w+/) {
239: $temp .= "my \$$_=\"$token->[2]->{$_}\";"
240: }
241: } @{$token->[3]};
1.8 albertel 242: return $temp;
243: }
1.22 ! albertel 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:
1.1 sakharuk 262: 1;
263: __END__
1.11 sakharuk 264:
265:
266:
267:
268:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonxml.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / xml