Annotation of loncom/xml/lonxml.pm, revision 1.15
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.15 ! albertel 63: $finaloutput .= &recurse($style_for_target{$token->[1]},
! 64: $target,$safeeval,\%style_for_target,
! 65: @parstack);
1.5 albertel 66: } else {
1.10 albertel 67: my $result = &callsub("start_$token->[1]", $target, $token,\@parstack,
1.14 albertel 68: $pars, $safeeval, \%style_for_target);
1.13 albertel 69: if ($result ne "" ) {
70: $finaloutput .= &Apache::run::evaluate($result,$safeeval,
71: $parstack[$#parstack]);
72: }
1.5 albertel 73: }
74: } elsif ($token->[0] eq 'E') {
1.9 albertel 75: #clear out any tags that didn't end
76: while ($token->[1] ne $stack[$#stack]
77: && ($#stack > 0)) {pop @stack;pop @parstack;}
78:
1.3 sakharuk 79: if (exists $style_for_target{'/'."$token->[1]"}) {
1.15 ! albertel 80: $finaloutput .= &recurse($style_for_target{'/'."$token->[1]"},
! 81: $target,$safeeval,\%style_for_target,
! 82: @parstack);
1.9 albertel 83: } else {
1.10 albertel 84: my $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
1.14 albertel 85: $pars,$safeeval, \%style_for_target);
1.13 albertel 86: if ($result ne "") {
87: $finaloutput .= &Apache::run::evaluate($result,$safeeval,
88: $parstack[$#parstack]);
89: }
1.2 sakharuk 90: }
1.9 albertel 91: pop @stack;
1.3 sakharuk 92: pop @parstack;
1.5 albertel 93: }
1.3 sakharuk 94: }
95: return $finaloutput;
1.15 ! albertel 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;
1.7 albertel 133: }
134:
135: sub callsub {
1.14 albertel 136: my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;
1.7 albertel 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";
1.14 albertel 143: $currentstring = &$sub($target,$token,\@$parstack,$parser,$safeeval,$style);
1.7 albertel 144: } else {
1.12 sakharuk 145: #print "NOT Calling sub $sub\n";
1.7 albertel 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;
1.1 sakharuk 155: }
156:
1.8 albertel 157: sub parstring {
158: my ($token) = @_;
159: my $temp='';
160: map {$temp .= "my \$$_=\"$token->[2]->{$_}\";"} @{$token->[3]};
161: return $temp;
162: }
1.1 sakharuk 163: 1;
164: __END__
1.11 sakharuk 165:
166:
167:
168:
169:
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