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