Annotation of loncom/xml/lonxml.pm, revision 1.6
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.4 albertel 11: use Apache::style;
1.3 sakharuk 12: use Apache::lontexconvert;
1.4 albertel 13: use Apache::londefdef;
1.6 ! albertel 14: use Apache::run;
1.3 sakharuk 15: #================================================== Main subroutine: xmlparse
16:
17: sub xmlparse {
18:
19: my ($target,$content_file_string,%style_for_target) = @_;
20: my $pars = HTML::TokeParser->new(\$content_file_string);
21: my $currentstring = '';
22: my $finaloutput = '';
23: my $newarg = '';
24: my $tempostring = '';
25: my $tempocont = '';
26: my $safeeval = new Safe;
1.6 ! albertel 27: $safeeval->permit("entereval");
1.3 sakharuk 28: #-------------------- Redefinition of the target in the case of compound target
29:
30: ($target, my @tenta) = split('&&',$target);
31:
32: #------------------------- Stack definition (in stack we have all current tags)
33:
34: my @stack = ();
35: my @parstack = ();
36:
37: #------------------------------------- Parse input string (content_file_string)
38:
39: my $token;
1.5 albertel 40:
1.3 sakharuk 41: while ($token = $pars->get_token) {
1.5 albertel 42: if ($token->[0] eq 'T') {
43: $finaloutput .= $token->[1];
44: $tempocont .= $token->[1];
45: } elsif ($token->[0] eq 'S') {
1.3 sakharuk 46: #------------------------------------------------------------- add tag to stack
1.5 albertel 47: push (@stack,$token->[1]);
1.3 sakharuk 48: #----------------------------------------- add parameters list to another stack
1.5 albertel 49: map {$tempostring .= "$_=$token->[2]->{$_},"} @{$token->[3]};
50: push (@parstack,$tempostring);
51: $tempostring = '';
52:
1.6 ! albertel 53: if (exists $style_for_target{$token->[1]}) {
! 54: # print "Style for $token->[1] is " .$style_for_target{$token->[1]}."\n";
1.3 sakharuk 55: #---------------------------------------------------- use style file definition
56:
1.5 albertel 57: $newarg = $style_for_target{$token->[1]};
58:
59: if (index($newarg,'script') != -1 ) {
60: my $pat = HTML::TokeParser->new(\$newarg);
1.6 ! albertel 61: my $tokenpat = '';
1.5 albertel 62: my $partstring = '';
63: my $oustring = '';
64: my $outputstring;
65:
66: while ($tokenpat = $pat->get_token) {
67: if ($tokenpat->[0] eq 'T') {
1.6 ! albertel 68: # print "evaluating $tokenpat->[4]\n";
! 69: $oustring .= &Apache::run::evaluate($tokenpat->[1],$safeeval);
1.5 albertel 70: } elsif ($tokenpat->[0] eq 'S') {
71: if ($tokenpat->[1] eq 'script') {
72: while ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') {
73: if ($tokenpat->[0] eq 'S') {
74: $partstring .= $tokenpat->[4];
75: } elsif ($tokenpat->[0] eq 'T') {
76: $partstring .= $tokenpat->[1];
77: } elsif ($tokenpat->[0] eq 'E') {
78: $partstring .= $tokenpat->[2];
79: }
80: }
81:
82: map {$partstring =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]};
1.6 ! albertel 83: # print "want to use run\n";
! 84: &Apache::run::run($partstring,$safeeval);
1.5 albertel 85:
86: $partstring = '';
87: } else {
1.6 ! albertel 88: # print "evaluating $tokenpat->[4]\n";
! 89: $oustring .= &Apache::run::evaluate($tokenpat->[4],$safeeval);
1.3 sakharuk 90: }
1.5 albertel 91: } elsif ($tokenpat->[0] eq 'E' and $tokenpat->[1] ne 'evaluate') {
1.6 ! albertel 92: # print "hereish\n";
1.5 albertel 93: $oustring .= $tokenpat->[1];
1.3 sakharuk 94: }
1.5 albertel 95: }
96: $newarg = $oustring;
97: } else {
98: map {$newarg =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]};
1.2 sakharuk 99: }
1.3 sakharuk 100: $finaloutput .= $newarg;
1.5 albertel 101: } else {
102: # use default definition of tag
103: my $sub="start_$token->[1]";
104: {
1.3 sakharuk 105: no strict 'refs';
1.5 albertel 106: if (defined (&$sub)) {
107: $currentstring = &$sub($target,$token,\@parstack);
108: $finaloutput .= $currentstring;
109: $currentstring = '';
1.3 sakharuk 110: } else {
111: $finaloutput .= $token->[4];
112: }
1.5 albertel 113: use strict 'refs';
114: }
115: }
116: } elsif ($token->[0] eq 'E') {
117: # Put here check for correct final tag (to avoid existence of
118: # starting tag only)
1.3 sakharuk 119:
120: pop @stack;
121: unless (exists $style_for_target{$token->[1]}) {
1.5 albertel 122: my $sub="end_$token->[1]";
1.3 sakharuk 123: {
1.5 albertel 124: no strict 'refs';
125: if (defined(&$sub)) {
126: $currentstring = &$sub($target,$token,\@parstack);
127: $finaloutput .= $currentstring;
128: $currentstring = '';
129: } else {
130: $finaloutput .= $token->[4];
131: }
132: use strict 'refs';
1.2 sakharuk 133: }
1.3 sakharuk 134: }
1.5 albertel 135: #---- end tag from the style file
1.3 sakharuk 136: if (exists $style_for_target{'/'."$token->[1]"}) {
137: $newarg = $style_for_target{'/'."$token->[1]"};
138: if (index($newarg,'script') != -1 ) {
139: my $pat = HTML::TokeParser->new(\$newarg);
140: my $tokenpat;
141: my $partstring = '';
142: my $oustring = '';
143: my $outputstring;
1.5 albertel 144:
1.3 sakharuk 145: while ($tokenpat = $pat->get_token) {
1.5 albertel 146: if ($tokenpat->[0] eq 'T') {
147: $oustring .= $tokenpat->[1];
148: } elsif ($tokenpat->[0] eq 'S') {
1.3 sakharuk 149: if ($tokenpat->[1] eq 'script') {
150: while ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') {
1.5 albertel 151: if ($tokenpat->[0] eq 'S') {
152: $partstring .= $tokenpat->[4];
153: } elsif ($tokenpat->[0] eq 'T') {
154: $partstring .= $tokenpat->[1];
155: } elsif ($tokenpat->[0] eq 'E') {
156: $partstring .= $tokenpat->[2];
157: }
1.2 sakharuk 158: }
1.5 albertel 159:
1.3 sakharuk 160: my @tempor_list = split(',',$parstack[$#parstack]);
161: my @te_kl = ();
162: my %tempor_hash = ();
163: map {(my $onete,my $twote) = split('=',$_); push (@te_kl,$onete);
164: $tempor_hash{$onete} = $twote} @tempor_list;
165: map {$partstring =~ s/\$$_/$tempor_hash{$_}/g; } @te_kl;
1.6 ! albertel 166: print "want to use run\n";
! 167: &Apache::run::run($partstring,$safeeval);
1.5 albertel 168:
1.3 sakharuk 169: $partstring = '';
170: } elsif ($tokenpat->[1] eq 'evaluate') {
1.6 ! albertel 171: $outputstring = &Apache::run::evaluate($tokenpat->[2]{expression},$safeeval);
1.5 albertel 172: $oustring .= $outputstring;
1.3 sakharuk 173: } else {
1.5 albertel 174: $oustring .= $tokenpat->[4];
1.3 sakharuk 175: }
1.5 albertel 176: } elsif ($tokenpat->[0] eq 'E' and $tokenpat->[1] ne 'evaluate') {
1.3 sakharuk 177: $oustring .= $tokenpat->[1];
1.5 albertel 178: }
1.3 sakharuk 179: }
1.5 albertel 180: $newarg = $oustring;
1.3 sakharuk 181: } else {
1.5 albertel 182: my @very_temp = split(',',$parstack[$#parstack]);
1.3 sakharuk 183: map {my @ret= split('=',$_); $newarg =~ s/\$$ret[0]/$ret[1]/g; } @very_temp;
1.2 sakharuk 184: }
1.5 albertel 185:
1.3 sakharuk 186: $finaloutput .= $newarg;
1.2 sakharuk 187: }
1.3 sakharuk 188: pop @parstack;
1.5 albertel 189: }
1.3 sakharuk 190: }
191: return $finaloutput;
1.1 sakharuk 192: }
193:
194: 1;
195: __END__
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