Annotation of loncom/xml/lonxml.pm, revision 1.13
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:
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;
1.6 albertel 38: $safeeval->permit("entereval");
1.13 ! albertel 39: $safeeval->permit(":base_math");
1.3 sakharuk 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;
1.5 albertel 52:
1.3 sakharuk 53: while ($token = $pars->get_token) {
1.5 albertel 54: if ($token->[0] eq 'T') {
1.7 albertel 55: $finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,'');
1.5 albertel 56: } elsif ($token->[0] eq 'S') {
1.7 albertel 57: # add tag to stack
1.5 albertel 58: push (@stack,$token->[1]);
1.7 albertel 59: # add parameters list to another stack
1.8 albertel 60: push (@parstack,&parstring($token));
1.5 albertel 61:
1.6 albertel 62: if (exists $style_for_target{$token->[1]}) {
1.8 albertel 63: #basically recurse, but we never got more than one level down so just
64: #create the new context here
65: my @innerstack = ();
66: my @innerparstack = ();
1.7 albertel 67: # use style file definition
1.8 albertel 68: $newarg = $style_for_target{$token->[1]};
1.7 albertel 69: my $pat = HTML::TokeParser->new(\$newarg);
70: my $tokenpat = '';
71: my $partstring = '';
1.8 albertel 72:
1.7 albertel 73: while ($tokenpat = $pat->get_token) {
74: if ($tokenpat->[0] eq 'T') {
75: $partstring = $tokenpat->[1];
76: } elsif ($tokenpat->[0] eq 'S') {
1.8 albertel 77: push (@innerstack,$tokenpat->[1]);
78: push (@innerparstack,&parstring($tokenpat));
79: $partstring = &callsub("start_$tokenpat->[1]",
1.10 albertel 80: $target, $tokenpat, \@innerparstack,
81: $pat, $safeeval);
1.7 albertel 82: } elsif ($tokenpat->[0] eq 'E') {
1.8 albertel 83: #clear out any tags that didn't end
84: while ($tokenpat->[1] ne $innerstack[$#innerstack]
85: && ($#innerstack > 0)) {pop @innerstack;pop @innerparstack;}
86: $partstring = &callsub("end_$tokenpat->[1]",
1.10 albertel 87: $target, $tokenpat, \@innerparstack,
88: $pat, $safeeval);
1.5 albertel 89: }
1.8 albertel 90: #pass both the variable to the style tag, and the tag we
91: #are processing inside the <definedtag>
1.13 ! albertel 92: if ($partstring ne "" ) {
! 93: $finaloutput .= &Apache::run::evaluate($partstring,$safeeval,
1.8 albertel 94: $parstack[$#parstack].$innerparstack[$#innerparstack]);
1.13 ! albertel 95: }
1.8 albertel 96: if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; }
1.2 sakharuk 97: }
1.5 albertel 98: } else {
1.10 albertel 99: my $result = &callsub("start_$token->[1]", $target, $token,\@parstack,
100: $pars, $safeeval);
1.13 ! albertel 101: if ($result ne "" ) {
! 102: $finaloutput .= &Apache::run::evaluate($result,$safeeval,
! 103: $parstack[$#parstack]);
! 104: }
1.5 albertel 105: }
106: } elsif ($token->[0] eq 'E') {
1.9 albertel 107: #clear out any tags that didn't end
108: while ($token->[1] ne $stack[$#stack]
109: && ($#stack > 0)) {pop @stack;pop @parstack;}
110:
1.3 sakharuk 111: if (exists $style_for_target{'/'."$token->[1]"}) {
1.9 albertel 112: my @innerstack = ();
113: my @innerparstack = ();
1.3 sakharuk 114: $newarg = $style_for_target{'/'."$token->[1]"};
1.9 albertel 115: my $pat = HTML::TokeParser->new(\$newarg);
116: my $tokenpat;
117: my $partstring = '';
118:
119: while ($tokenpat = $pat->get_token) {
120: if ($tokenpat->[0] eq 'T') {
1.12 sakharuk 121: $partstring = $tokenpat->[1];
1.9 albertel 122: } elsif ($tokenpat->[0] eq 'S') {
123: push (@innerstack,$tokenpat->[1]);
124: push (@innerparstack,&parstring($tokenpat));
125: $partstring = &callsub("start_$tokenpat->[1]",
1.10 albertel 126: $target, $tokenpat, \@innerparstack,
127: $pat, $safeeval);
1.9 albertel 128: } elsif ($tokenpat->[0] eq 'E') {
129: #clear out any tags that didn't end
130: while ($tokenpat->[1] ne $innerstack[$#innerstack]
131: && ($#innerstack > 0)) {pop @innerstack;pop @innerparstack;}
132: $partstring = &callsub("end_$tokenpat->[1]",
1.10 albertel 133: $target, $tokenpat, \@innerparstack,
134: $pat, $safeeval);
1.9 albertel 135: }
136: #pass both the variable to the style tag, and the tag we
137: #are processing inside the <definedtag>
1.13 ! albertel 138: if ( $partstring ne "" ) {
! 139: $finaloutput .= &Apache::run::evaluate($partstring,$safeeval,
1.9 albertel 140: $parstack[$#parstack].$innerparstack[$#innerparstack]);
1.13 ! albertel 141: }
1.9 albertel 142: if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; }
1.2 sakharuk 143: }
1.9 albertel 144: } else {
1.10 albertel 145: my $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
146: $pars,$safeeval);
1.13 ! albertel 147: if ($result ne "") {
! 148: $finaloutput .= &Apache::run::evaluate($result,$safeeval,
! 149: $parstack[$#parstack]);
! 150: }
1.2 sakharuk 151: }
1.9 albertel 152: pop @stack;
1.3 sakharuk 153: pop @parstack;
1.5 albertel 154: }
1.3 sakharuk 155: }
156: return $finaloutput;
1.7 albertel 157: }
158:
159: sub callsub {
1.10 albertel 160: my ($sub,$target,$token,$parstack,$parser,$safeeval)=@_;
1.7 albertel 161: my $currentstring='';
162: {
163: no strict 'refs';
164: if (my $space=$Apache::lonxml::alltags{$token->[1]}) {
165: #print "Calling sub $sub in $space \n";
166: $sub="$space\:\:$sub";
1.10 albertel 167: $currentstring = &$sub($target,$token,\@$parstack,$parser,$safeeval);
1.7 albertel 168: } else {
1.12 sakharuk 169: #print "NOT Calling sub $sub\n";
1.7 albertel 170: if (defined($token->[4])) {
171: $currentstring = $token->[4];
172: } else {
173: $currentstring = $token->[2];
174: }
175: }
176: use strict 'refs';
177: }
178: return $currentstring;
1.1 sakharuk 179: }
180:
1.8 albertel 181: sub parstring {
182: my ($token) = @_;
183: my $temp='';
184: map {$temp .= "my \$$_=\"$token->[2]->{$_}\";"} @{$token->[3]};
185: return $temp;
186: }
1.1 sakharuk 187: 1;
188: __END__
1.11 sakharuk 189:
190:
191:
192:
193:
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