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