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