Annotation of loncom/homework/cleanxml/post_xml.pm, revision 1.12
1.1 damieng 1: # The LearningOnline Network
2: # Third step to clean a file.
3: #
1.12 ! damieng 4: # $Id: post_xml.pm,v 1.11 2016/11/10 21:53:56 damieng Exp $
1.1 damieng 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: ###
29:
30: #!/usr/bin/perl
31:
32: package Apache::post_xml;
33:
34: use strict;
35: use utf8;
36: use warnings;
37:
38: use File::Basename;
39: use File::Temp qw/ tempfile /;
40: use Cwd 'abs_path';
41: use XML::LibXML;
42: use HTML::TokeParser; # used to parse sty files
43: use Tie::IxHash; # for ordered hashes
1.7 damieng 44: use tth;
45: use Apache::html_to_xml;
1.1 damieng 46:
47: no warnings 'recursion'; # yes, fix_paragraph is using heavy recursion, I know
48:
49: # these are constants
1.4 damieng 50: my @block_elements = ('parameter','location','answer','foil','image','polygon','rectangle','text','conceptgroup','itemgroup','item','label','data','function','array','unit','answergroup','functionplotresponse','functionplotruleset','functionplotelements','functionplotcustomrule','essayresponse','hintpart','formulahint','numericalhint','reactionhint','organichint','optionhint','radiobuttonhint','stringhint','customhint','mathhint','formulahintcondition','numericalhintcondition','reactionhintcondition','organichintcondition','optionhintcondition','radiobuttonhintcondition','stringhintcondition','customhintcondition','mathhintcondition','imageresponse','foilgroup','datasubmission','textfield','hiddensubmission','radiobuttonresponse','rankresponse','matchresponse','import','style','script','window','block','library','notsolved','part','postanswerdate','preduedate','problem','problemtype','randomlabel','bgimg','labelgroup','randomlist','solved','while','tex','print','web','gnuplot','curve','Task','IntroParagraph','ClosingParagraph','Question','QuestionText','Setup','Instance','InstanceText','Criteria','CriteriaText','GraderNote','languageblock','instructorcomment','dataresponse','togglebox','standalone','comment','drawimage','allow','displayduedate','displaytitle','responseparam','organicstructure','scriptlib','parserlib','drawoptionlist','spline','backgroundplot','plotobject','plotvector','drawvectorsum','functionplotrule','functionplotvectorrule','functionplotvectorsumrule','axis','key','xtics','ytics','title','xlabel','ylabel','hiddenline','dtm');
51: my @inline_like_block = ('stringresponse','optionresponse','numericalresponse','formularesponse','mathresponse','organicresponse','reactionresponse','customresponse','externalresponse', 'hint', 'hintgroup','translated','lang'); # inline elements treated like blocks for pretty print and some other things
1.1 damieng 52: my @responses = ('stringresponse','optionresponse','numericalresponse','formularesponse','mathresponse','organicresponse','reactionresponse','customresponse','externalresponse','essayresponse','radiobuttonresponse','matchresponse','rankresponse','imageresponse','functionplotresponse');
53: my @block_html = ('html','head','body','section','h1','h2','h3','h4','h5','h6','div','p','ul','ol','li','table','tbody','tr','td','th','dl','dt','dd','pre','noscript','hr','address','blockquote','object','applet','embed','map','form','fieldset','iframe','center','frameset');
54: my @no_newline_inside = ('import','parserlib','scriptlib','data','function','label','xlabel','ylabel','tic','text','rectangle','image','title','h1','h2','h3','h4','h5','h6','li','td','p');
1.6 damieng 55: my @preserve_elements = ('script','answer','pre','style');
1.1 damieng 56: my @accepting_style = ('section','h1','h2','h3','h4','h5','h6','div','p','li','td','th','dt','dd','pre','blockquote');
57: my @latex_math = ('\alpha', '\theta', '\omicron', '\tau', '\beta', '\vartheta', '\pi', '\upsilon', '\gamma', '\gamma', '\varpi', '\phi', '\delta', '\kappa', '\rho', '\varphi', '\epsilon', '\lambda', '\varrho', '\chi', '\varepsilon', '\mu', '\sigma', '\psi', '\zeta', '\nu', '\varsigma', '\omega', '\eta', '\xi',
58: '\Gamma', '\Lambda', '\Sigma', '\Psi', '\Delta', '\Xi', '\Upsilon', '\Omega', '\Theta', '\Pi', '\Phi',
59: '\pm', '\cap', '\diamond', '\oplus', '\mp', '\cup', '\bigtriangleup', '\ominus', '\times', '\uplus', '\bigtriangledown', '\otimes', '\div', '\sqcap', '\triangleleft', '\oslash', '\ast', '\sqcup', '\triangleright', '\odot', '\star', '\vee', '\lhd$', '\bigcirc', '\circ', '\wedge', '\rhd$', '\dagger', '\bullet', '\setminus', '\unlhd$', '\ddagger', '\cdot', '\wr', '\unrhd$', '\amalg', '+', '-',
60: '\leq', '\geq', '\equiv', '\models', '\prec', '\succ', '\sim', '\perp', '\preceq', '\succeq', '\simeq', '\mid', '\ll', '\gg', '\asymp', '\parallel', '\subset', '\supset', '\approx', '\bowtie', '\subseteq', '\supseteq', '\cong', '\Join$', '\sqsubset$', '\sqsupset$', '\neq', '\smile', '\sqsubseteq', '\sqsupseteq', '\doteq', '\frown', '\in', '\ni', '\propto', '\vdash', '\dashv',
61: '\colon', '\ldotp', '\cdotp',
62: '\leftarrow', '\longleftarrow', '\uparrow', '\Leftarrow', '\Longleftarrow', '\Uparrow', '\rightarrow', '\longrightarrow', '\downarrow', '\Rightarrow', '\Longrightarrow', '\Downarrow', '\leftrightarrow', '\longleftrightarrow', '\updownarrow', '\Leftrightarrow', '\Longleftrightarrow', '\Updownarrow', '\mapsto', '\longmapsto', '\nearrow', '\hookleftarrow', '\hookrightarrow', '\searrow', '\leftharpoonup', '\rightharpoonup', '\swarrow', '\leftharpoondown', '\rightharpoondown', '\nwarrow', '\rightleftharpoons', '\leadsto$',
63: '\ldots', '\cdots', '\vdots', '\ddots', '\aleph', '\prime', '\forall', '\infty', '\hbar', '\emptyset', '\exists', '\Box$', '\imath', '\nabla', '\neg', '\Diamond$', '\jmath', '\surd', '\flat', '\triangle', '\ell', '\top', '\natural', '\clubsuit', '\wp', '\bot', '\sharp', '\diamondsuit', '\Re', '\|', '\backslash', '\heartsuit', '\Im', '\angle', '\partial', '\spadesuit', '\mho$',
64: '\sum', '\bigcap', '\bigodot', '\prod', '\bigcup', '\bigotimes', '\coprod', '\bigsqcup', '\bigoplus', '\int', '\bigvee', '\biguplus', '\oint', '\bigwedge',
65: '\arccos', '\cos', '\csc', '\exp', '\ker', '\limsup', '\min', '\sinh', '\arcsin', '\cosh', '\deg', '\gcd', '\lg', '\ln', '\Pr', '\sup', '\arctan', '\cot', '\det', '\hom', '\lim', '\log', '\sec', '\tan', '\arg', '\coth', '\dim', '\inf', '\liminf', '\max', '\sin', '\tanh',
66: '\uparrow', '\Uparrow', '\downarrow', '\Downarrow', '\updownarrow', '\Updownarrow', '\lfloor', '\rfloor', '\lceil', '\rceil', '\langle', '\rangle', '\backslash',
67: '\rmoustache', '\lmoustache', '\rgroup', '\lgroup', '\arrowvert', '\Arrowvert', '\bracevert',
68: '\hat{', '\acute{', '\bar{', '\dot{', '\breve{', '\check{', '\grave{', '\vec{', '\ddot{', '\tilde{',
69: '\widetilde{', '\widehat{', '\overleftarrow{', '\overrightarrow{', '\overline{', '\underline{', '\overbrace{', '\underbrace{', '\sqrt{', '\sqrt[', '\frac{'
70: );
71: # list of elements that can contain style elements:
72: my @containing_styles = ('library','problem',@responses,'foil','item','text','hintgroup','hintpart','label','part','preduedate','postanswerdate','solved','notsolved','block','while','web','standalone','problemtype','languageblock','translated','lang','window','windowlink','togglebox','instructorcomment','body','section','div','p','li','dd','td','th','blockquote','object','applet','video','audio','canvas','fieldset','button',
73: 'span','strong','em','b','i','sup','sub','code','kbd','samp','tt','ins','del','var','small','big','u','font');
74: my @html_styles = ('span', 'strong', 'em' , 'b', 'i', 'sup', 'sub', 'tt', 'var', 'small', 'big', 'u');
75:
76: my $warnings; # 1 = print warnings
77:
78:
79: # Parses the XML document and fixes many things to turn it into a document matching the schema.
1.2 damieng 80: # @param {reference} textref - reference to the text of the document
81: # @param {string} file_path - path of the file being processed (we only extract the directory path from it)
82: # @param {string} res_dir - path of res directory parent (without the / at the end)
83: # @param {boolean} warn - 1 to print warnings, 0 otherwise
84: # @returns the text of the document as a byte string.
1.1 damieng 85: sub post_xml {
1.2 damieng 86: my ($textref, $file_path, $res_dir, $warn) = @_;
1.1 damieng 87: $warnings = $warn;
88:
89: my $dom_doc = XML::LibXML->load_xml(string => $textref);
90:
91: my $root = fix_structure($dom_doc);
92:
93: remove_elements($root, ['startouttext','startoutext','startottext','startouttex','startouttect','atartouttext','starouttext','starttextout','starttext','starttextarea','endouttext','endoutext','endoutttext','endouttxt','endouutext','ednouttext','endouttex','endoouttext','endouttest','endtextout','endtextarea','startpartmarker','endpartmarker','basefont','x-claris-tagview','x-claris-window','x-sas-window']);
94:
95: remove_empty_attributes($root);
96:
97: fix_attribute_case($root);
98:
1.3 damieng 99: replace_m($root);
1.1 damieng 100:
101: my @all_block = (@block_elements, @block_html);
1.2 damieng 102: add_sty_blocks($file_path, $res_dir, $root, \@all_block); # must come before the subs using @all_block
1.1 damieng 103:
104: fix_block_styles($root, \@all_block);
105: $root->normalize();
106:
107: fix_fonts($root, \@all_block);
108:
109: replace_u($root);
110:
111: remove_bad_cdata_sections($root);
112:
113: add_cdata_sections($root);
114:
115: fix_style_element($root);
116:
117: fix_tables($root);
118:
119: fix_lists($root);
120:
121: fix_wrong_name_for_img($root); # should be before replace_deprecated_attributes_by_css
122:
123: replace_deprecated_attributes_by_css($root);
124:
125: replace_center($root, \@all_block); # must come after replace_deprecated_attributes_by_css
126:
127: replace_nobr($root);
128:
129: remove_useless_notsolved($root);
130:
1.9 damieng 131: fix_comments($root);
132:
1.1 damieng 133: fix_paragraphs_inside($root, \@all_block);
134:
135: remove_empty_style($root);
136:
137: fix_empty_lc_elements($root);
138:
1.10 damieng 139: reduce_empty_p($root);
140:
1.1 damieng 141: lowercase_attribute_values($root);
142:
143: replace_numericalresponse_unit_attribute($root);
144:
145: replace_functions_by_elements($root);
146:
147: pretty($root, \@all_block);
148:
149: replace_tm_dtm($root);
150:
151: return $dom_doc->toString(); # byte string !
152: }
153:
154: sub fix_structure {
155: my ($doc) = @_;
156: # the root element has already been added in pre_xml
157: my $root = $doc->documentElement;
158: # inside the root, replace html, problem and library elements by their content
1.5 damieng 159: my @toreplace = ('html','problem','library','Task');
1.1 damieng 160: foreach my $name (@toreplace) {
161: my @elements = $root->getElementsByTagName($name);
162: foreach my $element (@elements) {
163: replace_by_children($element);
164: }
165: }
166: # insert all link and style elements inside a new head element
167: my $current_node = undef;
168: my @heads = $doc->getElementsByTagName('head');
169: my @links = $doc->getElementsByTagName('link');
170: my @styles = $doc->getElementsByTagName('style');
171: my @titles = $doc->getElementsByTagName('title');
172: if (scalar(@titles) > 0) {
173: # NOTE: there is a title element in gnuplot, not to be confused with the one inside HTML head
174: for (my $i=0; $i<scalar(@titles); $i++) {
175: my $title = $titles[$i];
176: my $found_gnuplot = 0;
177: my $ancestor = $title->parentNode;
178: while (defined $ancestor) {
179: if ($ancestor->nodeName eq 'gnuplot') {
180: $found_gnuplot = 1;
181: last;
182: }
183: $ancestor = $ancestor->parentNode;
184: }
185: if ($found_gnuplot) {
186: splice(@titles, $i, 1);
187: $i--;
188: }
189: }
190: }
191: if (scalar(@heads) > 0 || scalar(@titles) > 0 || scalar(@links) > 0 || scalar(@styles) > 0) {
192: my $htmlhead = $doc->createElement('head');
193: foreach my $head (@heads) {
194: my $next;
195: for (my $child=$head->firstChild; defined $child; $child=$next) {
196: $next = $child->nextSibling;
197: $head->removeChild($child);
198: if ($child->nodeType != XML_ELEMENT_NODE ||
199: string_in_array(['title','script','style','meta','link','import','base'], $child->nodeName)) {
200: $htmlhead->appendChild($child);
201: } else {
202: # this should not be in head
203: insert_after_or_first($root, $child, $current_node);
204: }
205: }
206: $head->parentNode->removeChild($head);
207: }
208: foreach my $child (@titles, @links, @styles) {
209: $child->parentNode->removeChild($child);
210: $htmlhead->appendChild($child);
211: }
212: insert_after_or_first($root, $htmlhead, $current_node);
213: $current_node = $htmlhead;
214: }
215: # body
216: my $htmlbody = undef;
217: my @bodies = $doc->getElementsByTagName('body');
218: if (scalar(@bodies) > 0) {
219: # TODO: fix content and position of body elements
220: if ($root->nodeName eq 'problem') {
221: foreach my $body (@bodies) {
222: replace_by_children($body);
223: }
224: }
225: }
226: # add all the meta elements afterwards when they are LON-CAPA meta. Remove all HTML meta.
227: my @meta_names = ('abstract','author','authorspace','avetries','avetries_list','clear','comefrom','comefrom_list','copyright','correct','count','course','course_list','courserestricted','creationdate','dependencies','depth','difficulty','difficulty_list','disc','disc_list','domain','end','field','firstname','generation','goto','goto_list','groupname','helpful','highestgradelevel','hostname','id','keynum','keywords','language','lastname','lastrevisiondate','lowestgradelevel','middlename','mime','modifyinguser','notes','owner','permanentemail','scope','sequsage','sequsage_list','standards','start','stdno','stdno_list','subject','technical','title','url','username','value','version');
228: my @metas = $doc->getElementsByTagName('meta');
229: foreach my $meta (@metas) {
230: $meta->parentNode->removeChild($meta);
231: my $name = $meta->getAttribute('name');
232: my $content = $meta->getAttribute('content');
233: if (defined $name && defined $content && string_in_array(\@meta_names, lc($name))) {
234: my $lcmeta = $doc->createElement('meta');
235: $lcmeta->setAttribute('name', lc($name));
236: $lcmeta->setAttribute('content', $content);
237: insert_after_or_first($root, $lcmeta, $current_node);
238: $current_node = $lcmeta;
239: }
240: }
241: return($root);
242: }
243:
244: # insert the new child under parent after the reference child, or as the first child if the reference child is not defined
245: sub insert_after_or_first {
246: my ($parent, $newchild, $refchild) = @_;
247: if (defined $refchild) {
248: $parent->insertAfter($newchild, $refchild);
249: } elsif (defined $parent->firstChild) {
250: $parent->insertBefore($newchild, $parent->firstChild);
251: } else {
252: $parent->appendChild($newchild);
253: }
254: }
255:
256: # removes all elements with given names inside the node, but keep the content
257: sub remove_elements {
258: my ($node, $to_remove) = @_;
259: my $nextChild;
260: for (my $child=$node->firstChild; defined $child; $child=$nextChild) {
261: $nextChild = $child->nextSibling;
262: my $type = $node->nodeType;
263: if ($type == XML_ELEMENT_NODE) {
264: if (string_in_array($to_remove, $child->nodeName)) {
265: my $first_non_white = $child->firstChild;
266: if (defined $first_non_white && $first_non_white->nodeType == XML_TEXT_NODE &&
267: $first_non_white->nodeValue =~ /^\s*$/) {
268: $first_non_white = $first_non_white->nextSibling;
269: }
270: if (defined $first_non_white) {
271: $nextChild = $first_non_white;
272: replace_by_children($child);
273: } else {
274: $node->removeChild($child);
275: }
276: } else {
277: remove_elements($child, $to_remove);
278: }
279: }
280: }
281: }
282:
283: # removes some attributes that have an invalid empty value
284: sub remove_empty_attributes {
285: my ($root) = @_;
286: my $doc = $root->ownerDocument;
287: # this list is based on validation errors in the MSU subset (it could be more complete if it was based on the schema)
288: my @attributes = (
289: ['curve', ['pointsize']],
290: ['foil', ['location']],
291: ['foilgroup', ['checkboxoptions', 'options', 'texoptions']],
292: ['gnuplot', ['pattern', 'texwidth']],
293: ['img', ['height', 'texheight', 'texwidth', 'texwrap', 'width']],
294: ['import', ['importmode']],
295: ['optionresponse', ['max']],
296: ['organicstructure', ['options']],
297: ['radiobuttonresponse', ['max']],
298: ['randomlabel', ['height', 'texwidth', 'width']],
299: ['stringresponse', ['type']],
300: ['textline', ['size']],
301: );
302: foreach my $element_attributes (@attributes) {
303: my $element_name = $element_attributes->[0];
304: my $attribute_names = $element_attributes->[1];
305: my @elements = $doc->getElementsByTagName($element_name);
306: foreach my $element (@elements) {
307: foreach my $attribute_name (@$attribute_names) {
308: my $value = $element->getAttribute($attribute_name);
309: if (defined $value && $value =~ /^\s*$/) {
310: $element->removeAttribute($attribute_name);
311: }
312: }
313: }
314: }
315: }
316:
317: # fixes the case for a few attributes that are not all lowercase
318: # (the HTML parser used in html_to_xml turns everything lowercase, which is a good thing in general)
319: sub fix_attribute_case {
320: my ($root) = @_;
321: my $doc = $root->ownerDocument;
322: my @attributes = (
323: ['labelgroup', ['TeXsize']],
324: ['h1', ['TeXsize']],
325: ['h2', ['TeXsize']],
326: ['h3', ['TeXsize']],
327: ['h4', ['TeXsize']],
328: ['h5', ['TeXsize']],
329: ['h6', ['TeXsize']],
330: # font and basefont have a TeXsize but will be removed
331: ['optionresponse', ['TeXlayout']],
332: ['itemgroup', ['TeXitemgroupwidth']],
333: ['Task', ['OptionalRequired']],
334: ['Question', ['OptionalRequired','Mandatory']],
335: ['Instance', ['OptionalRequired','Disabled']],
336: ['Criteria', ['Mandatory']],
337: ['table', ['TeXwidth','TeXtheme']],
338: ['td', ['TeXwidth']],
339: ['th', ['TeXwidth']],
340: ['img', ['TeXwidth','TeXheight','TeXwrap']],
341: );
342: foreach my $element_attributes (@attributes) {
343: my $element_name = $element_attributes->[0];
344: my $attribute_names = $element_attributes->[1];
345: my @elements = $doc->getElementsByTagName($element_name);
346: foreach my $element (@elements) {
347: foreach my $attribute_name (@$attribute_names) {
348: my $value = $element->getAttribute(lc($attribute_name));
349: if (defined $value) {
350: $element->removeAttribute(lc($attribute_name));
351: $element->setAttribute($attribute_name, $value);
352: }
353: }
354: }
355: }
356: }
357:
358: # Replaces m by HTML, tm and/or dtm (which will be replaced by <m> later, but they are useful
359: # to know if the element is a block element or not).
360: # m might contain non-math LaTeX, while tm and dtm may only contain math.
361: sub replace_m {
362: my ($root) = @_;
363: my $doc = $root->ownerDocument;
364: # search for variable declarations
365: my @variables = ();
366: my @scripts = $root->getElementsByTagName('script');
367: foreach my $script (@scripts) {
368: my $type = $script->getAttribute('type');
369: if (defined $type && $type eq 'loncapa/perl') {
370: if (defined $script->firstChild && $script->firstChild->nodeType == XML_TEXT_NODE) {
371: my $text = $script->firstChild->nodeValue;
372: # NOTE: we are not interested in replacing "@value", only "$value"
373: # this regexp is for " $a = ..." and " $a[...] = ..."
374: while ($text =~ /^[ \t]*\$([a-zA-Z_0-9]+)(?:\[[^\]]+\])?[ \t]*=/gm) {
375: if (!string_in_array(\@variables, $1)) {
376: push(@variables, $1);
377: }
378: }
379: # this regexp is for "...; $a = ..." and "...; $a[...] = ..."
380: while ($text =~ /^[^'"\/;]+;[ \t]*\$([a-zA-Z_0-9]+)(?:\[[^\]]+\])?[ \t]*=/gm) {
381: if (!string_in_array(\@variables, $1)) {
382: push(@variables, $1);
383: }
384: }
385: # this regexp is for " @a = ..."
386: while ($text =~ /^[ \t]*\@([a-zA-Z_0-9]+)[ \t]*=/gm) {
387: if (!string_in_array(\@variables, $1)) {
388: push(@variables, $1);
389: }
390: }
391: # this regexp is for " ($a, $b, $c) = ..."
392: my @matches = ($text =~ /^[ \t]*\([ \t]*\$([a-zA-Z_0-9]+)(?:[ \t]*,[ \t]*\$([a-zA-Z_0-9]+))*[ \t]*\)[ \t]*=/gm);
393: foreach my $match (@matches) {
394: if (!defined $match) {
395: next; # not sure why it happens, but it does
396: }
397: if (!string_in_array(\@variables, $match)) {
398: push(@variables, $match);
399: }
400: }
401: # and this one is for "push @a"
402: while ($text =~ /^[ \t]*push @([a-zA-Z_0-9]+)[ \t,]*/gm) {
403: if (!string_in_array(\@variables, $1)) {
404: push(@variables, $1);
405: }
406: }
407: # use the opportunity to report usage of <m> in Perl scripts
408: if ($text =~ /^[^#].*<m[ >]/m) {
409: if ($warnings) {
410: print "WARNING: <m> is used in a script, it should be converted by hand\n";
411: }
412: }
413: }
414: }
415: }
416: my @ms = $root->getElementsByTagName('m');
417: foreach my $m (@ms) {
418: if (!defined $m->firstChild) {
419: $m->parentNode->removeChild($m);
420: next;
421: }
422: if (defined $m->firstChild->nextSibling || $m->firstChild->nodeType != XML_TEXT_NODE) {
423: if ($warnings) {
424: print "WARNING: m value is not simple text\n";
425: }
426: next;
427: }
428: my $text = $m->firstChild->nodeValue;
429: my $text_before_variable_replacement = $text;
430: my $var_key1 = 'dfhg3df54hg65hg4';
431: my $var_key2 = 'dfhg654d6f5g4h5f';
432: my $eval = defined $m->getAttribute('eval') && $m->getAttribute('eval') eq 'on';
1.12 ! damieng 433: my $display = $m->getAttribute('display');
! 434: if (defined $display) {
! 435: if ($display eq '') {
! 436: $display = undef;
! 437: }
! 438: if (lc($display) eq 'jsmath') {
! 439: $display = 'mathjax';
! 440: }
! 441: }
1.1 damieng 442: if ($eval) {
443: # replace variables
444: foreach my $variable (@variables) {
445: my $replacement = $var_key1.$variable.$var_key2;
446: $text =~ s/\$$variable(?![a-zA-Z])/$replacement/ge;
447: $text =~ s/\$\{$variable\}/$replacement/ge;
448: }
449: }
450: # check if the expression is enclosed in math separators: $ $$ \( \) \[ \]
451: # if so, replace the whole node by dtm or tm
452: my $new_text;
453: my $new_node_name;
454: if ($text =~ /^\s*\$\$([^\$]*)\$\$\s*$/) {
455: $new_node_name = 'dtm';
456: $new_text = $1;
457: } elsif ($text =~ /^\s*\\\[(.*)\\\]\s*$/s) {
458: $new_node_name = 'dtm';
459: $new_text = $1;
460: } elsif ($text =~ /^\s*\$([^\$]*)\$\s*$/) {
461: $new_node_name = 'tm';
462: $new_text = $1;
463: } elsif ($text =~ /^\s*\\\((.*)\\\)\s*$/s) {
464: $new_node_name = 'tm';
465: $new_text = $1;
466: }
467: if (defined $new_node_name) {
468: if ($eval) {
469: foreach my $variable (@variables) {
470: my $replacement = $var_key1.$variable.$var_key2;
471: $new_text =~ s/$replacement([a-zA-Z])/\${$variable}$1/g;
472: $new_text =~ s/$replacement/\$$variable/g;
473: }
474: }
475: my $new_node = $doc->createElement($new_node_name);
476: if ($eval) {
477: $new_node->setAttribute('eval', 'on');
478: }
1.12 ! damieng 479: if (defined $display) {
! 480: $new_node->setAttribute('display', $display);
! 481: }
1.1 damieng 482: $new_node->appendChild($doc->createTextNode($new_text));
483: $m->parentNode->replaceChild($new_node, $m);
484: next;
485: }
486: if ($text !~ /\$|\\\(|\\\)|\\\[|\\\]/) {
487: # there are no math separators inside
488: # try to guess if this is meant as math
489: my $found_math = 0;
490: foreach my $symbol (@latex_math) {
491: if (index($text, $symbol) != -1) {
492: $found_math = 1;
493: last;
494: }
495: }
496: if ($found_math) {
497: # interpret the whole text as LaTeX inline math
498: my $new_node = $doc->createElement('tm');
499: if ($eval) {
500: $new_node->setAttribute('eval', 'on');
501: }
502: $new_node->appendChild($doc->createTextNode($text_before_variable_replacement));
503: $m->parentNode->replaceChild($new_node, $m);
504: next;
505: }
506: # no math symbol found, we will convert the text with tth
507: }
508:
509: # there are math separators inside, even after hiding variables, or there was no math symbol
510:
511: # hide math parts inside before running tth
1.12 ! damieng 512: my $math_key1 = '#5752398247516385';
1.1 damieng 513: my $math_key2 = '#';
514: my @maths = ();
515: my @separators = (['$$','$$'], ['\\(','\\)'], ['\\[','\\]'], ['$','$']);
516: foreach my $seps (@separators) {
517: my $sep1 = $seps->[0];
518: my $sep2 = $seps->[1];
519: my $pos1 = index($text, $sep1);
520: if ($pos1 == -1) {
521: next;
522: }
523: my $pos2 = index($text, $sep2, $pos1+length($sep1));
524: while ($pos1 != -1 && $pos2 != -1) {
525: my $replace = substr($text, $pos1, $pos2+length($sep2)-$pos1);
526: push(@maths, $replace);
527: my $by = $math_key1.scalar(@maths).$math_key2;
528: $text = substr($text, 0, $pos1).$by.substr($text, $pos2+length($sep2));
529: $pos1 = index($text, $sep1);
530: if ($pos1 != -1) {
531: $pos2 = index($text, $sep2, $pos1+length($sep1));
532: }
533: }
534: }
535: # get HTML as text from tth
536: my $html_text = tth($text);
537: # replace math by replacements
538: for (my $i=0; $i < scalar(@maths); $i++) {
539: my $math = $maths[$i];
540: $math =~ s/&/&/g;
541: $math =~ s/</</g;
542: $math =~ s/>/>/g;
1.12 ! damieng 543: my ($mel, $inside);
1.1 damieng 544: if ($math =~ /^\$\$(.*)\$\$$/s) {
1.12 ! damieng 545: $mel = 'dtm';
! 546: $inside = $1;
1.1 damieng 547: } elsif ($math =~ /^\\\[(.*)\\\]$/s) {
1.12 ! damieng 548: $mel = 'dtm';
! 549: $inside = $1;
1.1 damieng 550: } elsif ($math =~ /^\\\((.*)\\\)$/s) {
1.12 ! damieng 551: $mel = 'tm';
! 552: $inside = $1;
1.1 damieng 553: } elsif ($math =~ /^\$(.*)\$$/s) {
1.12 ! damieng 554: $mel = 'tm';
! 555: $inside = $1;
! 556: }
! 557: if (defined $inside) {
! 558: if ($inside =~ /^\s*$/) {
! 559: $math = '';
! 560: } else {
! 561: $math = '<'.$mel;
! 562: if ($eval && $inside =~ /$var_key1/) {
! 563: $math .= ' eval="on"';
! 564: }
! 565: $math .= '>'.$inside.'</'.$mel.'>';
! 566: }
1.1 damieng 567: }
568: my $replace = $math_key1.($i+1).$math_key2;
569: $html_text =~ s/$replace/$math/;
570: }
571: # replace variables if necessary
572: if ($eval) {
573: foreach my $variable (@variables) {
574: my $replacement = $var_key1.$variable.$var_key2;
575: $html_text =~ s/$replacement([a-zA-Z])/\${$variable}$1/g;
576: $html_text =~ s/$replacement/\$$variable/g;
577: }
578: }
579: my $fragment = html_to_dom($html_text);
580: $doc->adoptNode($fragment);
581: $m->parentNode->replaceChild($fragment, $m);
582:
583: }
584: }
585:
586: # Returns the HTML equivalent of LaTeX input, using tth
587: sub tth {
588: my ($text) = @_;
1.7 damieng 589: my $output = &tth::tth($text);
590: my $errorstring = &tth::ttherror();
591: if ($errorstring) {
592: die $errorstring;
593: }
1.1 damieng 594: # hopefully the temp file will not be removed before this point (otherwise we should use unlink_on_destroy 0)
595: $output =~ s/^\s*|\s*$//;
596: $output =~ s/<div class="p"><!----><\/div>/<br\/>/; # why is tth using such ugly markup for \newline ?
597: return $output;
598: }
599:
600: # transform simple HTML into a DOM fragment (which will need to be adopted by the document)
601: sub html_to_dom {
602: my ($text) = @_;
603: $text = '<root>'.$text.'</root>';
1.7 damieng 604: my $textref = Apache::html_to_xml::html_to_xml(\$text);
1.1 damieng 605: utf8::upgrade($$textref); # otherwise the XML parser fails when the HTML parser turns into a character
606: my $dom_doc = XML::LibXML->load_xml(string => $textref);
607: my $root = $dom_doc->documentElement;
608: remove_empty_style($root);
609: my $fragment = $dom_doc->createDocumentFragment();
610: my $next;
611: for (my $n=$root->firstChild; defined $n; $n=$next) {
612: $next = $n->nextSibling;
613: $root->removeChild($n);
614: $fragment->appendChild($n);
615: }
616: return($fragment);
617: }
618:
619: # Use the linked sty files to guess which newly defined elements should be considered blocks.
620: # Also adds to @containing_styles the sty elements that contain styles.
621: # @param {string} fn - the file path (we only extract the directory path from it)
1.2 damieng 622: # @param {string} res_dir - path of res directory parent (without the / at the end)
623: # @param {Element} root - the root element
1.1 damieng 624: sub add_sty_blocks {
1.2 damieng 625: my ($fn, $res_dir, $root, $all_block) = @_;
1.1 damieng 626: my $doc = $root->ownerDocument;
627: my @parserlibs = $doc->getElementsByTagName('parserlib');
628: my @libs = ();
629: foreach my $parserlib (@parserlibs) {
630: if (defined $parserlib->firstChild && $parserlib->firstChild->nodeType == XML_TEXT_NODE) {
631: my $value = $parserlib->firstChild->nodeValue;
632: $value =~ s/^\s+|\s+$//g;
633: if ($value ne '') {
634: push(@libs, $value);
635: }
636: }
637: }
638: my ($name, $path, $suffix) = fileparse($fn);
639: foreach my $sty (@libs) {
640: if (substr($sty, 0, 1) eq '/') {
1.2 damieng 641: $sty = $res_dir.$sty;
1.1 damieng 642: } else {
643: $sty = $path.$sty;
644: }
645: my $new_elements = parse_sty($sty, $all_block);
646: better_guess($root, $new_elements, $all_block);
647: my $new_blocks = $new_elements->{'block'};
648: my $new_inlines = $new_elements->{'inline'};
649: push(@$all_block, @{$new_blocks});
650: #push(@inlines, @{$new_inlines}); # we are not using a list of inline elements at this point
651: }
652: }
653:
654: ##
655: # Parses a sty file and returns lists of block and inline elements.
656: # @param {string} fn - the file path
657: ##
658: sub parse_sty {
659: my ($fn, $all_block) = @_;
660: my @blocks = ();
661: my @inlines = ();
662: my $p = HTML::TokeParser->new($fn);
663: if (! $p) {
664: die "post_xml.pl: parse_sty: Error reading $fn\n";
665: }
666: $p->empty_element_tags(1);
667: my $in_definetag = 0;
668: my $in_render = 0;
669: my %newtags = ();
670: my $newtag = '';
671: my $is_block = 0;
672: while (my $token = $p->get_token) {
673: if ($token->[0] eq 'S') {
674: my $tag = lc($token->[1]);
675: if ($tag eq 'definetag') {
676: $in_definetag = 1;
677: $is_block = 0;
678: my $attributes = $token->[2];
679: $newtag = $attributes->{'name'};
680: if (substr($newtag, 0, 1) eq '/') {
681: $newtag = substr($newtag, 1);
682: }
683: } elsif ($in_definetag && $tag eq 'render') {
684: $in_render = 1;
685: $is_block = 0;
686: } elsif ($in_render) {
687: if (string_in_array($all_block, $tag)) {
688: $is_block = 1;
689: }
690: }
691: } elsif ($token->[0] eq 'E') {
692: my $tag = lc($token->[1]);
693: if ($tag eq 'definetag') {
694: $in_definetag = 0;
695: if (defined $newtags{$newtag}) {
696: $newtags{$newtag} = $newtags{$newtag} || $is_block;
697: } else {
698: $newtags{$newtag} = $is_block;
699: }
700: } elsif ($in_definetag && $tag eq 'render') {
701: $in_render = 0;
702: }
703: }
704: }
705: foreach $newtag (keys(%newtags)) {
706: if ($newtags{$newtag} == 1) {
707: push(@blocks, $newtag);
708: } else {
709: push(@inlines, $newtag);
710: }
711: }
712: return {'block'=>\@blocks, 'inline'=>\@inlines};
713: }
714:
715: ##
716: # Marks as block the elements that contain block elements in the input file.
717: # Also adds to @containing_styles the sty elements that contain styles.
718: # @param {string} fn - the file path
719: # @param {Hash<string,Array>} new_elements - contains arrays in 'block' and 'inline'
720: ##
721: sub better_guess {
722: my ($root, $new_elements, $all_block) = @_;
723: my $new_blocks = $new_elements->{'block'};
724: my $new_inlines = $new_elements->{'inline'};
725:
726: my @change = (); # change these elements from inline to block
727: foreach my $tag (@{$new_inlines}) {
728: my @nodes = $root->getElementsByTagName($tag);
729: NODE_LOOP: foreach my $node (@nodes) {
730: for (my $child=$node->firstChild; defined $child; $child=$child->nextSibling) {
731: if ($child->nodeType == XML_ELEMENT_NODE) {
732: if (string_in_array($all_block, $child->nodeName) || string_in_array($new_blocks, $child->nodeName)) {
733: push(@change, $tag);
734: last NODE_LOOP;
735: }
736: }
737: }
738: }
739: }
740: foreach my $inline (@change) {
741: my $index = 0;
742: $index++ until $new_inlines->[$index] eq $inline;
743: splice(@{$new_inlines}, $index, 1);
744: push(@{$new_blocks}, $inline);
745: }
746: # add to @containing_styles when a style is used inside
747: # NOTE: some sty elements will be added even though they should not, but if we don't do that
748: # all style will be removed in the sty elements.
749: foreach my $tag ((@{$new_blocks}, @{$new_inlines})) {
750: my @nodes = $root->getElementsByTagName($tag);
751: NODE_LOOP: foreach my $node (@nodes) {
752: for (my $child=$node->firstChild; defined $child; $child=$child->nextSibling) {
753: if ($child->nodeType == XML_ELEMENT_NODE) {
754: if (string_in_array(\@html_styles, $child->nodeName)) {
755: push(@containing_styles, $tag);
756: last NODE_LOOP;
757: }
758: }
759: }
760: }
761: }
762: }
763:
764: # When a style element contains a block, move the style inside the block where it is allowed.
765: # style/block/other -> block/style/other
766: # When a style is used where it is not allowed, move it inside its children or remove it (unless it contains only text)
767: # element_not_containing_styles/style/other -> element_not_containing_styles/other/style (except if other is a style)
768: # The fix is not perfect in the case of element_not_containing_styles/style1/style2/block/text (style1 will be lost):
769: # element_not_containing_styles/style1/style2/block/text -> element_not_containing_styles/block/style2/text
770: # (a solution to this problem would be to merge the styles in a span)
771: # NOTE: .sty defined elements might have been added to @containing_styles by better_guess().
772: sub fix_block_styles {
773: my ($element, $all_block) = @_;
774: my $doc = $element->ownerDocument;
775: if (string_in_array(\@html_styles, $element->nodeName)) {
776: # move spaces out of the style element
777: if (defined $element->firstChild && $element->firstChild->nodeType == XML_TEXT_NODE) {
778: my $child = $element->firstChild;
779: if ($child->nodeValue =~ /^(\s+)(\S.*)$/s) {
780: $element->parentNode->insertBefore($doc->createTextNode($1), $element);
781: $child->setData($2);
782: }
783: }
784: if (defined $element->lastChild && $element->lastChild->nodeType == XML_TEXT_NODE) {
785: my $child = $element->lastChild;
786: if ($child->nodeValue =~ /^(.*\S)(\s+)$/s) {
787: $element->parentNode->insertAfter($doc->createTextNode($2), $element);
788: $child->setData($1);
789: }
790: }
791:
792: my $found_block = 0;
793: for (my $child=$element->firstChild; defined $child; $child=$child->nextSibling) {
794: if ($child->nodeType == XML_ELEMENT_NODE && string_in_array($all_block, $child->nodeName)) {
795: $found_block = 1;
796: last;
797: }
798: }
799: my $no_style_here = !string_in_array(\@containing_styles, $element->parentNode->nodeName);
800: if ($found_block || $no_style_here) {
801: # there is a block or the style is not allowed here,
802: # the style element has to be replaced by its modified children
803: my $s; # a clone of the style
804: my $next;
805: for (my $child=$element->firstChild; defined $child; $child=$next) {
806: $next = $child->nextSibling;
807: if ($child->nodeType == XML_ELEMENT_NODE && (string_in_array($all_block, $child->nodeName) ||
808: $child->nodeName eq 'br' || $no_style_here)) {
809: # avoid inverting a style with a style with $no_style_here (that would cause endless recursion)
810: if (!$no_style_here || (!string_in_array(\@html_styles, $child->nodeName) &&
811: string_in_array(\@containing_styles, $child->nodeName))) {
812: # block node or inline node when the style is not allowed:
813: # move all children inside the style, and make the style the only child
814: $s = $element->cloneNode();
815: my $next2;
816: for (my $child2=$child->firstChild; defined $child2; $child2=$next2) {
817: $next2 = $child2->nextSibling;
818: $child->removeChild($child2);
819: $s->appendChild($child2);
820: }
821: $child->appendChild($s);
822: }
823: $s = undef;
824: } elsif (($child->nodeType == XML_TEXT_NODE && $child->nodeValue !~ /^\s*$/) ||
825: $child->nodeType == XML_ELEMENT_NODE) {
826: # if the style is allowed, move text and inline nodes inside the style
827: if (!$no_style_here) {
828: if (!defined $s) {
829: $s = $element->cloneNode();
830: $element->insertBefore($s, $child);
831: }
832: $element->removeChild($child);
833: $s->appendChild($child);
834: }
835: } else {
836: # do not put other nodes inside the style
837: $s = undef;
838: }
839: }
840: # now replace by children and fix them
841: my $parent = $element->parentNode;
842: for (my $child=$element->firstChild; defined $child; $child=$next) {
843: $next = $child->nextSibling;
844: $element->removeChild($child);
845: $parent->insertBefore($child, $element);
846: if ($child->nodeType == XML_ELEMENT_NODE) {
847: fix_block_styles($child, $all_block);
848: }
849: }
850: $parent->removeChild($element);
851: return;
852: }
853: }
854: # otherwise fix all children
855: my $next;
856: for (my $child=$element->firstChild; defined $child; $child=$next) {
857: $next = $child->nextSibling;
858: if ($child->nodeType == XML_ELEMENT_NODE) {
859: fix_block_styles($child, $all_block);
860: }
861: }
862: }
863:
864: # removes empty font elements and font elements that contain at least one block element
865: # replaces other font elements by equivalent span
866: sub fix_fonts {
867: my ($root, $all_block) = @_;
868: my $doc = $root->ownerDocument;
869: my @fonts = $root->getElementsByTagName('font');
870: @fonts = reverse(@fonts); # to deal with the ancestor last in the case of font/font
871: foreach my $font (@fonts) {
872: my $block = 0;
873: for (my $child=$font->firstChild; defined $child; $child=$child->nextSibling) {
874: if (string_in_array($all_block, $child->nodeName) || string_in_array(\@inline_like_block, $child->nodeName)) {
875: $block = 1;
876: last;
877: }
878: }
879: if (!defined $font->firstChild || $block) {
880: # empty font or font containing block elements
881: # replace this node by its content
882: replace_by_children($font);
883: } else {
884: # replace by equivalent span
885: my $color = get_non_empty_attribute($font, 'color');
886: my $size = get_non_empty_attribute($font, 'size');
887: my $face = get_non_empty_attribute($font, 'face');
888: if (defined $face) {
889: $face =~ s/^,|,$//;
890: }
891: if (!defined $color && !defined $size && !defined $face) {
892: # useless font element: replace this node by its content
893: replace_by_children($font);
894: next;
895: }
896: my $replacement;
897: tie (my %properties, 'Tie::IxHash', ());
898: if (!defined $color && !defined $size && defined $face && lc($face) eq 'symbol') {
899: $replacement = $doc->createDocumentFragment();
900: } else {
901: $replacement = $doc->createElement('span');
902: my $css = '';
903: if (defined $color) {
904: $color =~ s/^x/#/;
905: $properties{'color'} = $color;
906: }
907: if (defined $size) {
908: my %hash = (
909: '1' => 'x-small',
910: '2' => 'small',
911: '3' => 'medium',
912: '4' => 'large',
913: '5' => 'x-large',
914: '6' => 'xx-large',
915: '7' => '300%',
916: '-1' => 'small',
917: '-2' => 'x-small',
918: '+1' => 'large',
919: '+2' => 'x-large',
920: '+3' => 'xx-large',
921: '+4' => '300%',
922: );
923: my $value = $hash{$size};
924: if (!defined $value) {
925: $value = 'medium';
926: }
927: $properties{'font-size'} = $value;
928: }
929: if (defined $face) {
930: if (lc($face) ne 'symbol' && lc($face) ne 'bold') {
931: $properties{'font-family'} = $face;
932: }
933: }
934: set_css_properties($replacement, \%properties);
935: }
936: if (defined $face && lc($face) eq 'symbol') {
937: # convert all content to unicode
938: my $next;
939: for (my $child=$font->firstChild; defined $child; $child=$next) {
940: $next = $child->nextSibling;
941: if ($child->nodeType == XML_TEXT_NODE) {
942: my $value = $child->nodeValue;
943: $value =~ tr/ABGDEZHQIKLMNXOPRSTUFCYWabgdezhqiklmnxoprVstufcywJjv¡«¬®/ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩαβγδεζηθικλμνξοπρςστυφχψωϑϕϖϒ↔←→/;
944: $child->setData($value);
945: }
946: }
947: }
948: # replace the font node
949: if ($replacement->nodeType == XML_ELEMENT_NODE && !defined $font->previousSibling &&
950: !defined $font->nextSibling && string_in_array(\@accepting_style, $font->parentNode->nodeName)) {
951: # use CSS on the parent block and replace font by its children instead of using a new element
952: set_css_properties($font->parentNode, \%properties);
953: replace_by_children($font);
954: } else {
955: # move all font children inside the replacement (span or fragment)
956: my $next;
957: for (my $child=$font->firstChild; defined $child; $child=$next) {
958: $next = $child->nextSibling;
959: $font->removeChild($child);
960: $replacement->appendChild($child);
961: }
962: # replace font
963: $font->parentNode->replaceChild($replacement, $font);
964: }
965: }
966: }
967: $root->normalize();
968: }
969:
970: # replaces u by <span style="text-decoration: underline">
971: sub replace_u {
972: my ($root) = @_;
973: my $doc = $root->ownerDocument;
974: my @us = $root->getElementsByTagName('u');
975: foreach my $u (@us) {
976: my $span = $doc->createElement('span');
977: $span->setAttribute('style', 'text-decoration: underline');
978: my $next;
979: for (my $child=$u->firstChild; defined $child; $child=$next) {
980: $next = $child->nextSibling;
981: $u->removeChild($child);
982: $span->appendChild($child);
983: }
984: $u->parentNode->replaceChild($span, $u);
985: }
986: }
987:
988: # removes CDATA sections tags that have not been parsed correcty by the HTML parser
989: # also removes bad comments in script elements
990: sub remove_bad_cdata_sections {
991: my ($root) = @_;
992: my $doc = $root->ownerDocument;
993: foreach my $name (@preserve_elements) {
994: my @nodes = $root->getElementsByTagName($name);
995: foreach my $node (@nodes) {
996: if (defined $node->firstChild && $node->firstChild->nodeType == XML_TEXT_NODE) {
997: my $value = $node->firstChild->nodeValue;
998: if ($name eq 'script' && (!defined $node->getAttribute('type') || $node->getAttribute('type') ne 'loncapa/perl') &&
999: !defined $node->firstChild->nextSibling && $value =~ /^(\s*)<!--(.*)-->(\s*)$/) {
1000: # web browsers interpret that as a real comment when it is on 1 line, but the Perl HTML parser thinks it is the script
1001: # -> turning it back into a comment
1002: # (this is only true for Javascript script elements, since LON-CAPA does not parse loncapa/perl scripts in the same way)
1003: $node->removeChild($node->firstChild);
1004: $node->appendChild($doc->createComment($2));
1005: next;
1006: }
1007: # at the beginning:
1008: $value =~ s/^(\s*)<!\[CDATA\[/$1/; # <![CDATA[
1009: $value =~ s/^(\s*)\/\*\s*<!\[CDATA\[\s*\*\//$1/; # /* <![CDATA[ */
1010: $value =~ s/^(\s*)\/\/\s*<!\[CDATA\[/$1/; # // <![CDATA[
1011: $value =~ s/^(\s*)(\/\/)?\s*<!--/$1/; # // <!--
1012: # at the end:
1013: $value =~ s/\/\/\s*\]\]>(\s*)$/$1/; # // ]]>
1014: $value =~ s/\]\]>(\s*)$/$1/; # ]]>
1015: $value =~ s/(\/\/)?\s*-->(\s*)$/$2/; # // -->
1016: $value =~ s/\/\*\s*\]\]>\s*\*\/(\s*)$/$1/; # /* ]]> */
1017:
1018: $value = "\n".$value."\n";
1019: $value =~ s/\s*(\n[ \t]*)/$1/;
1020: $value =~ s/\s+$/\n/;
1021: $node->firstChild->setData($value);
1022: }
1023: }
1024: }
1025: }
1026:
1027: # adds CDATA sections to scripts
1028: sub add_cdata_sections {
1029: my ($root) = @_;
1030: my $doc = $root->ownerDocument;
1031: my @scripts = $root->getElementsByTagName('script');
1032: my @answers = $root->getElementsByTagName('answer');
1033: foreach my $answer (@answers) {
1034: my $ancestor = $answer->parentNode;
1035: my $found_capa_response = 0;
1036: while (defined $ancestor) {
1037: if ($ancestor->nodeName eq 'numericalresponse' || $ancestor->nodeName eq 'formularesponse') {
1038: $found_capa_response = 1;
1039: last;
1040: }
1041: $ancestor = $ancestor->parentNode;
1042: }
1043: if (!$found_capa_response) {
1044: push(@scripts, $answer);
1045: }
1046: }
1047: foreach my $script (@scripts) {
1048: # use a CDATA section in the normal situation, for any script
1049: my $first = $script->firstChild;
1050: if (defined $first && $first->nodeType == XML_TEXT_NODE && !defined $first->nextSibling) {
1051: my $cdata = $doc->createCDATASection($first->nodeValue);
1052: $script->replaceChild($cdata, $first);
1053: }
1054: }
1055: }
1056:
1057: # removes "<!--" and "-->" at the beginning and end of style elements
1058: sub fix_style_element {
1059: my ($root) = @_;
1060: my @styles = $root->getElementsByTagName('style');
1061: foreach my $style (@styles) {
1062: if (defined $style->firstChild && $style->firstChild->nodeType == XML_TEXT_NODE &&
1063: !defined $style->firstChild->nextSibling) {
1064: my $text = $style->firstChild->nodeValue;
1065: if ($text =~ /^\s*<!--(.*)-->\s*$/s) {
1066: $style->firstChild->setData($1);
1067: }
1068: }
1069: }
1070: }
1071:
1072: # create missing cells at the end of table rows
1073: sub fix_tables {
1074: my ($root) = @_;
1075: my @tables = $root->getElementsByTagName('table');
1076: foreach my $table (@tables) {
1077: fix_cells($table);
1078: foreach my $tbody ($table->getChildrenByTagName('tbody')) {
1079: fix_cells($tbody);
1080: }
1081: foreach my $thead ($table->getChildrenByTagName('thead')) {
1082: fix_cells($thead);
1083: }
1084: foreach my $tfoot ($table->getChildrenByTagName('tfoot')) {
1085: fix_cells($tfoot);
1086: }
1087: }
1088: }
1089:
1090: # create missing cells at the end of table rows
1091: sub fix_cells {
1092: my ($table) = @_; # could actually be table, tbody, thead or tfoot
1093: my $doc = $table->ownerDocument;
1094: my @nb_cells = ();
1095: my $max_nb_cells = 0;
1096: my @rowspans = ();
1097: my @trs = $table->getChildrenByTagName('tr');
1098: foreach my $tr (@trs) {
1099: my $nb_cells;
1100: if (defined $rowspans[0]) {
1101: $nb_cells = shift(@rowspans);
1102: } else {
1103: $nb_cells = 0;
1104: }
1105: for (my $cell=$tr->firstChild; defined $cell; $cell=$cell->nextSibling) {
1106: if ($cell->nodeName eq 'td' || $cell->nodeName eq 'th') {
1107: my $colspan = $cell->getAttribute('colspan');
1108: if (defined $colspan && $colspan =~ /^\s*[0-9]+\s*$/) {
1109: $nb_cells += $colspan;
1110: } else {
1111: $nb_cells++;
1112: }
1113: my $rowspan = $cell->getAttribute('rowspan');
1114: if (defined $rowspan && $rowspan =~ /^\s*[0-9]+\s*$/) {
1115: for (my $i=0; $i < $rowspan-1; $i++) {
1116: if (!defined $rowspans[$i]) {
1117: $rowspans[$i] = 1;
1118: } else {
1119: $rowspans[$i]++;
1120: }
1121: }
1122: }
1123: }
1124: }
1125: push(@nb_cells, $nb_cells);
1126: if ($nb_cells > $max_nb_cells) {
1127: $max_nb_cells = $nb_cells;
1128: }
1129: }
1130: foreach my $tr (@trs) {
1131: my $nb_cells = shift(@nb_cells);
1132: if ($nb_cells < $max_nb_cells) {
1133: for (1..($max_nb_cells - $nb_cells)) {
1134: $tr->appendChild($doc->createElement('td'));
1135: }
1136: }
1137: }
1138: }
1139:
1140: # replaces ul/ul by ul/li/ul and the same for ol (using the previous li if possible)
1141: # also adds a ul element when a li has no ul/ol ancestor
1142: sub fix_lists {
1143: my ($root) = @_;
1144: my $doc = $root->ownerDocument;
1145: my @uls = $root->getElementsByTagName('ul');
1146: my @ols = $root->getElementsByTagName('ol');
1147: my @lists = (@uls, @ols);
1148: foreach my $list (@lists) {
1149: my $next;
1150: for (my $child=$list->firstChild; defined $child; $child=$next) {
1151: $next = $child->nextSibling;
1152: if ($child->nodeType == XML_ELEMENT_NODE && string_in_array(['ul','ol'], $child->nodeName)) {
1153: my $previous = $child->previousNonBlankSibling(); # note: non-DOM method
1154: $list->removeChild($child);
1155: if (defined $previous && $previous->nodeType == XML_ELEMENT_NODE && $previous->nodeName eq 'li') {
1156: $previous->appendChild($child);
1157: } else {
1158: my $li = $doc->createElement('li');
1159: $li->appendChild($child);
1160: if (!defined $next) {
1161: $list->appendChild($li);
1162: } else {
1163: $list->insertBefore($li, $next);
1164: }
1165: }
1166: }
1167: }
1168: }
1169: my @lis = $root->getElementsByTagName('li');
1170: foreach my $li (@lis) {
1171: my $found_list_ancestor = 0;
1172: my $ancestor = $li->parentNode;
1173: while (defined $ancestor) {
1174: if ($ancestor->nodeName eq 'ul' || $ancestor->nodeName eq 'ol') {
1175: $found_list_ancestor = 1;
1176: last;
1177: }
1178: $ancestor = $ancestor->parentNode;
1179: }
1180: if (!$found_list_ancestor) {
1181: # replace li by ul and add li under ul
1182: my $ul = $doc->createElement('ul');
1183: $li->parentNode->insertBefore($ul, $li);
1184: $li->parentNode->removeChild($li);
1185: $ul->appendChild($li);
1186: # add all other li afterwards inside ul (there might be text nodes in-between)
1187: my $next = $ul->nextSibling;
1188: while (defined $next) {
1189: my $next_next = $next->nextSibling;
1190: if ($next->nodeType == XML_TEXT_NODE && $next->nodeValue =~ /^\s*$/ &&
1191: defined $next_next && $next_next->nodeType == XML_ELEMENT_NODE && $next_next->nodeName eq 'li') {
1192: $next->parentNode->removeChild($next);
1193: $ul->appendChild($next);
1194: $next = $next_next;
1195: $next_next = $next_next->nextSibling;
1196: }
1197: if ($next->nodeType == XML_ELEMENT_NODE && $next->nodeName eq 'li') {
1198: $next->parentNode->removeChild($next);
1199: $ul->appendChild($next);
1200: } else {
1201: last;
1202: }
1203: $next = $next_next;
1204: }
1205: }
1206: }
1207: }
1208:
1209: # Some "image" elements are actually img element with a wrong name. This renames them.
1210: # Amazingly enough, "<image src=..." displays an image in some browsers
1211: # ("image" has existed at some point as an experimental HTML element).
1212: sub fix_wrong_name_for_img {
1213: my ($root) = @_;
1214: my @images = $root->getElementsByTagName('image');
1215: foreach my $image (@images) {
1216: if (!defined $image->getAttribute('src')) {
1217: next;
1218: }
1219: my $found_correct_ancestor = 0;
1220: my $ancestor = $image->parentNode;
1221: while (defined $ancestor) {
1222: if ($ancestor->nodeName eq 'drawimage' || $ancestor->nodeName eq 'imageresponse') {
1223: $found_correct_ancestor = 1;
1224: last;
1225: }
1226: $ancestor = $ancestor->parentNode;
1227: }
1228: if ($found_correct_ancestor) {
1229: next;
1230: }
1231: # this really has to be renamed "img"
1232: $image->setNodeName('img');
1233: }
1234: }
1235:
1236: # Replaces many deprecated attributes and replaces them by equivalent CSS when possible
1237: sub replace_deprecated_attributes_by_css {
1238: my ($root) = @_;
1239:
1240: fix_deprecated_in_tables($root);
1241:
1242: fix_deprecated_in_table_rows($root);
1243:
1244: fix_deprecated_in_table_cells($root);
1245:
1246: fix_deprecated_in_lists($root);
1247:
1248: fix_deprecated_in_list_items($root);
1249:
1250: fix_deprecated_in_hr($root);
1251:
1252: fix_deprecated_in_img($root);
1253:
1254: fix_deprecated_in_body($root);
1255:
1256: fix_align_attribute($root);
1257: }
1258:
1259: # Replaces deprecated attributes in tables
1260: sub fix_deprecated_in_tables {
1261: my ($root) = @_;
1262: my @tables = $root->getElementsByTagName('table');
1263: foreach my $table (@tables) {
1264: tie (my %new_properties, 'Tie::IxHash', ());
1265: my $align = $table->getAttribute('align');
1266: if (defined $align) {
1267: $table->removeAttribute('align');
1268: $align = lc(trim($align));
1269: }
1270: if ($table->parentNode->nodeName eq 'center' || (defined $align && $align eq 'center') ||
1271: (defined $table->parentNode->getAttribute('align') && $table->parentNode->getAttribute('align') eq 'center')) {
1272: $new_properties{'margin-left'} = 'auto';
1273: $new_properties{'margin-right'} = 'auto';
1274: }
1275: if (defined $align && ($align eq 'left' || $align eq 'right')) {
1276: $new_properties{'float'} = $align;
1277: }
1278: my $width = $table->getAttribute('width');
1279: if (defined $width) {
1280: $table->removeAttribute('width');
1281: $width = trim($width);
1282: if ($width =~ /^[0-9]+$/) {
1283: $width .= 'px';
1284: }
1285: if ($width ne '') {
1286: $new_properties{'width'} = $width;
1287: }
1288: }
1289: my $height = $table->getAttribute('height');
1290: if (defined $height) {
1291: $table->removeAttribute('height');
1292: # no replacement for table height
1293: }
1294: my $bgcolor = $table->getAttribute('bgcolor');
1295: if (defined $bgcolor) {
1296: $table->removeAttribute('bgcolor');
1297: $bgcolor = trim($bgcolor);
1298: $bgcolor =~ s/^x\s*//;
1299: if ($bgcolor ne '') {
1300: $new_properties{'background-color'} = $bgcolor;
1301: }
1302: }
1303: my $frame = $table->getAttribute('frame');
1304: if (defined $frame) {
1305: $table->removeAttribute('frame');
1306: $frame = lc(trim($frame));
1307: if ($frame eq 'void') {
1308: $new_properties{'border'} = 'none';
1309: } elsif ($frame eq 'above') {
1310: $new_properties{'border-top'} = '1px solid black';
1311: } elsif ($frame eq 'below') {
1312: $new_properties{'border-bottom'} = '1px solid black';
1313: } elsif ($frame eq 'hsides') {
1314: $new_properties{'border-top'} = '1px solid black';
1315: $new_properties{'border-bottom'} = '1px solid black';
1316: } elsif ($frame eq 'vsides') {
1317: $new_properties{'border-left'} = '1px solid black';
1318: $new_properties{'border-right'} = '1px solid black';
1319: } elsif ($frame eq 'lhs') {
1320: $new_properties{'border-left'} = '1px solid black';
1321: } elsif ($frame eq 'rhs') {
1322: $new_properties{'border-right'} = '1px solid black';
1323: } elsif ($frame eq 'box') {
1324: $new_properties{'border'} = '1px solid black';
1325: } elsif ($frame eq 'border') {
1326: $new_properties{'border'} = '1px solid black';
1327: }
1328: }
1329: if (scalar(keys %new_properties) > 0) {
1330: set_css_properties($table, \%new_properties);
1331: }
1332: # we can't replace the border attribute without creating a style block, but we can improve things like border="BORDER"
1333: my $border = $table->getAttribute('border');
1334: if (defined $border) {
1335: $border = trim($border);
1336: if ($border !~ /^\s*[0-9]+\s*(px)?\s*$/) {
1337: $table->setAttribute('border', '1');
1338: }
1339: }
1340: }
1341:
1342: }
1343:
1344: # Replaces deprecated attributes in tr elements
1345: sub fix_deprecated_in_table_rows {
1346: my ($root) = @_;
1347: my @trs = $root->getElementsByTagName('tr');
1348: foreach my $tr (@trs) {
1349: my $old_properties = get_css_properties($tr);
1350: tie (my %new_properties, 'Tie::IxHash', ());
1351: my $bgcolor = $tr->getAttribute('bgcolor');
1352: if (defined $bgcolor) {
1353: $tr->removeAttribute('bgcolor');
1354: if (!defined $old_properties->{'background-color'}) {
1355: $bgcolor = trim($bgcolor);
1356: $bgcolor =~ s/^x\s*//;
1357: if ($bgcolor ne '') {
1358: $new_properties{'background-color'} = $bgcolor;
1359: }
1360: }
1361: }
1362: my $align = $tr->getAttribute('align');
1363: if (defined $align && $align !~ /\s*char\s*/i) {
1364: $tr->removeAttribute('align');
1365: if (!defined $old_properties->{'text-align'}) {
1366: $align = lc(trim($align));
1367: if ($align ne '') {
1368: $new_properties{'text-align'} = $align;
1369: }
1370: }
1371: }
1372: my $valign = $tr->getAttribute('valign');
1373: if (defined $valign) {
1374: $tr->removeAttribute('valign');
1375: if (!defined $old_properties->{'vertical-align'}) {
1376: $valign = lc(trim($valign));
1377: if ($valign ne '') {
1378: $new_properties{'vertical-align'} = $valign;
1379: }
1380: }
1381: }
1382: if (scalar(keys %new_properties) > 0) {
1383: set_css_properties($tr, \%new_properties);
1384: }
1385: }
1386: }
1387:
1388: # Replaces deprecated attributes in table cells (td and th)
1389: sub fix_deprecated_in_table_cells {
1390: my ($root) = @_;
1391: my @tds = $root->getElementsByTagName('td');
1392: my @ths = $root->getElementsByTagName('th');
1393: my @cells = (@tds, @ths);
1394: foreach my $cell (@cells) {
1395: my $old_properties = get_css_properties($cell);
1396: tie (my %new_properties, 'Tie::IxHash', ());
1397: my $width = $cell->getAttribute('width');
1398: if (defined $width) {
1399: $cell->removeAttribute('width');
1400: if (!defined $old_properties->{'width'}) {
1401: $width = trim($width);
1402: if ($width =~ /^[0-9]+$/) {
1403: $width .= 'px';
1404: }
1405: if ($width ne '') {
1406: $new_properties{'width'} = $width;
1407: }
1408: }
1409: }
1410: my $height = $cell->getAttribute('height');
1411: if (defined $height) {
1412: $cell->removeAttribute('height');
1413: if (!defined $old_properties->{'height'}) {
1414: $height = trim($height);
1415: if ($height =~ /^[0-9]+$/) {
1416: $height .= 'px';
1417: }
1418: if ($height ne '') {
1419: $new_properties{'height'} = $height;
1420: }
1421: }
1422: }
1423: my $bgcolor = $cell->getAttribute('bgcolor');
1424: if (defined $bgcolor) {
1425: $cell->removeAttribute('bgcolor');
1426: if (!defined $old_properties->{'background-color'}) {
1427: $bgcolor = trim($bgcolor);
1428: $bgcolor =~ s/^x\s*//;
1429: if ($bgcolor ne '') {
1430: $new_properties{'background-color'} = $bgcolor;
1431: }
1432: }
1433: }
1434: my $align = $cell->getAttribute('align');
1435: if (defined $align && $align !~ /\s*char\s*/i) {
1436: $cell->removeAttribute('align');
1437: if (!defined $old_properties->{'text-align'}) {
1438: $align = lc(trim($align));
1439: if ($align ne '') {
1440: $new_properties{'text-align'} = $align;
1441: }
1442: }
1443: }
1444: my $valign = $cell->getAttribute('valign');
1445: if (defined $valign) {
1446: $cell->removeAttribute('valign');
1447: if (!defined $old_properties->{'vertical-align'}) {
1448: $valign = lc(trim($valign));
1449: if ($valign ne '') {
1450: $new_properties{'vertical-align'} = $valign;
1451: }
1452: }
1453: }
1454: if (scalar(keys %new_properties) > 0) {
1455: set_css_properties($cell, \%new_properties);
1456: }
1457: }
1458: }
1459:
1460: # Replaces deprecated attributes in lists (ul and ol)
1461: sub fix_deprecated_in_lists {
1462: my ($root) = @_;
1463: my @uls = $root->getElementsByTagName('ul');
1464: my @ols = $root->getElementsByTagName('ol');
1465: my @lists = (@uls, @ols);
1466: foreach my $list (@lists) {
1467: my $type = $list->getAttribute('type');
1468: if (defined $type) {
1469: my $lst = list_style_type($type);
1470: if (defined $lst) {
1471: $list->removeAttribute('type');
1472: if (!defined get_css_property($list, 'list-style-type')) {
1473: set_css_property($list, 'list-style-type', $lst);
1474: }
1475: }
1476: }
1477: }
1478: }
1479:
1480: # Replaces deprecated attributes in list items (li)
1481: sub fix_deprecated_in_list_items {
1482: my ($root) = @_;
1483: my @lis = $root->getElementsByTagName('li');
1484: foreach my $li (@lis) {
1485: my $type = $li->getAttribute('type');
1486: if (defined $type) {
1487: my $lst = list_style_type($type);
1488: if (defined $lst) {
1489: $li->removeAttribute('type');
1490: if (!defined get_css_property($li, 'list-style-type')) {
1491: set_css_property($li, 'list-style-type', $lst);
1492: }
1493: }
1494: }
1495: }
1496: }
1497:
1498: # returns the CSS list-style-type value equivalent to the given type attribute for a list or list item
1499: sub list_style_type {
1500: my ($type) = @_;
1501: my $value;
1502: $type = trim($type);
1503: if (lc($type) eq 'circle') {
1504: $value = 'circle';
1505: } elsif (lc($type) eq 'disc') {
1506: $value = 'disc';
1507: } elsif (lc($type) eq 'square') {
1508: $value = 'square';
1509: } elsif ($type eq 'a') {
1510: $value = 'lower-latin';
1511: } elsif ($type eq 'A') {
1512: $value = 'upper-latin';
1513: } elsif ($type eq 'i') {
1514: $value = 'lower-roman';
1515: } elsif ($type eq 'I') {
1516: $value = 'upper-roman';
1517: } elsif ($type eq '1') {
1518: $value = 'decimal';
1519: }
1520: return $value;
1521: }
1522:
1523: # Replaces deprecated attributes in hr
1524: sub fix_deprecated_in_hr {
1525: my ($root) = @_;
1526: my @hrs = $root->getElementsByTagName('hr');
1527: foreach my $hr (@hrs) {
1528: tie (my %new_properties, 'Tie::IxHash', ());
1529: my $align = $hr->getAttribute('align');
1530: if (defined $align) {
1531: $align = lc(trim($align));
1532: if ($align eq 'left') {
1533: $new_properties{'text-align'} = 'left';
1534: $new_properties{'margin-left'} = '0';
1535: } elsif ($align eq 'right') {
1536: $new_properties{'text-align'} = 'right';
1537: $new_properties{'margin-right'} = '0';
1538: }
1539: $hr->removeAttribute('align');
1540: }
1541: my $color = $hr->getAttribute('color');
1542: if (defined $color) {
1543: $color = trim($color);
1544: $color =~ s/^x\s*//;
1545: if ($color ne '') {
1546: $new_properties{'color'} = $color;
1547: $new_properties{'background-color'} = $color;
1548: }
1549: $hr->removeAttribute('color');
1550: }
1551: my $noshade = $hr->getAttribute('noshade');
1552: my $size = $hr->getAttribute('size');
1553: if (defined $noshade) {
1554: $new_properties{'border-width'} = '0';
1555: if (!defined $color) {
1556: $new_properties{'color'} = 'gray';
1557: $new_properties{'background-color'} = 'gray';
1558: }
1559: if (!defined $size) {
1560: $size = '2';
1561: }
1562: $hr->removeAttribute('noshade');
1563: }
1564: if (defined $size) {
1565: $size = trim($size);
1566: if ($size ne '') {
1567: $new_properties{'height'} = $size.'px';
1568: }
1569: if (defined $hr->getAttribute('size')) {
1570: $hr->removeAttribute('size');
1571: }
1572: }
1573: my $width = $hr->getAttribute('width');
1574: if (defined $width) {
1575: $width = trim($width);
1576: if ($width ne '') {
1577: if ($width !~ /\%$/) {
1578: $width .= 'px';
1579: }
1580: $new_properties{'width'} = $width;
1581: }
1582: $hr->removeAttribute('width');
1583: }
1584: if (scalar(keys %new_properties) > 0) {
1585: set_css_properties($hr, \%new_properties);
1586: }
1587: }
1588: }
1589:
1590: # Replaces deprecated attributes in img
1591: sub fix_deprecated_in_img {
1592: my ($root) = @_;
1593: my @imgs = $root->getElementsByTagName('img');
1594: foreach my $img (@imgs) {
1595: my $old_properties = get_css_properties($img);
1596: tie (my %new_properties, 'Tie::IxHash', ());
1597: my $align = $img->getAttribute('align');
1598: if (defined $align) {
1599: $align = lc(trim($align));
1600: if ($align eq 'middle' || $align eq 'top' || $align eq 'bottom') {
1601: $img->removeAttribute('align');
1602: if (!defined $old_properties->{'vertical-align'}) {
1603: $new_properties{'vertical-align'} = $align;
1604: }
1605: } elsif ($align eq 'left' || $align eq 'right') {
1606: $img->removeAttribute('align');
1607: if (!defined $old_properties->{'float'}) {
1608: $new_properties{'float'} = $align;
1609: }
1610: } elsif ($align eq 'center' || $align eq '') {
1611: $img->removeAttribute('align');
1612: }
1613: }
1614: my $border = $img->getAttribute('border');
1615: if (defined $border) {
1616: $border = lc(trim($border));
1617: if ($border =~ /^[0-9]+\s*(px)?$/) {
1618: $img->removeAttribute('border');
1619: if (!defined $old_properties->{'border'}) {
1620: if ($border !~ /px$/) {
1621: $border .= 'px';
1622: }
1623: $new_properties{'border'} = $border.' solid black';
1624: }
1625: }
1626: }
1627: my $hspace = $img->getAttribute('hspace');
1628: if (defined $hspace) {
1629: $hspace = lc(trim($hspace));
1630: if ($hspace =~ /^[0-9]+\s*(px)?$/) {
1631: $img->removeAttribute('hspace');
1632: if (!defined $old_properties->{'margin-left'} || !defined $old_properties->{'margin-right'}) {
1633: if ($hspace !~ /px$/) {
1634: $hspace .= 'px';
1635: }
1636: $new_properties{'margin-left'} = $hspace;
1637: $new_properties{'margin-right'} = $hspace;
1638: }
1639: }
1640: }
1641: if (scalar(keys %new_properties) > 0) {
1642: set_css_properties($img, \%new_properties);
1643: }
1644: }
1645: }
1646:
1647: # Replaces deprecated attributes in htmlbody (the style attribute could be used in a div for output)
1648: sub fix_deprecated_in_body {
1649: my ($root) = @_;
1650: my $doc = $root->ownerDocument;
1651: my @bodies = $root->getElementsByTagName('htmlbody');
1652: foreach my $body (@bodies) {
1653: my $old_properties = get_css_properties($body);
1654: tie (my %new_properties, 'Tie::IxHash', ());
1655: my $bgcolor = $body->getAttribute('bgcolor');
1656: if (defined $bgcolor) {
1657: $body->removeAttribute('bgcolor');
1658: if (!defined $old_properties->{'background-color'}) {
1659: $bgcolor = trim($bgcolor);
1660: $bgcolor =~ s/^x\s*//;
1661: if ($bgcolor ne '') {
1662: $new_properties{'background-color'} = $bgcolor;
1663: }
1664: }
1665: }
1666: my $color = $body->getAttribute('text');
1667: if (defined $color) {
1668: $body->removeAttribute('text');
1669: if (!defined $old_properties->{'color'}) {
1670: $color = trim($color);
1671: $color =~ s/^x\s*//;
1672: if ($color ne '') {
1673: $new_properties{'color'} = $color;
1674: }
1675: }
1676: }
1677: my $background = $body->getAttribute('background');
1678: if (defined $background && ($background =~ /\.jpe?g$|\.gif|\.png/i)) {
1679: $body->removeAttribute('background');
1680: if (!defined $old_properties->{'background-image'}) {
1681: $background = trim($background);
1682: if ($background ne '') {
1683: $new_properties{'background-image'} = 'url('.$background.')';
1684: }
1685: }
1686: }
1687: # NOTE: these attributes have never been standard and are better removed with no replacement
1688: foreach my $bad ('bottommargin', 'leftmargin', 'rightmargin', 'topmargin', 'marginheight', 'marginwidth') {
1689: if ($body->hasAttribute($bad)) {
1690: $body->removeAttribute($bad);
1691: }
1692: }
1693: # NOTE: link alink and vlink require a <style> block to be converted
1694: my $link = $body->getAttribute('link');
1695: my $alink = $body->getAttribute('alink');
1696: my $vlink = $body->getAttribute('vlink');
1697: if (defined $link || defined $alink || defined $vlink) {
1698: my $head;
1699: my @heads = $root->getElementsByTagName('htmlhead');
1700: if (scalar(@heads) > 0) {
1701: $head = $heads[0];
1702: } else {
1703: $head = $doc->createElement('htmlhead');
1704: $root->insertBefore($head, $root->firstChild);
1705: }
1706: my $style = $doc->createElement('style');
1707: $head->appendChild($style);
1708: my $css = "\n";
1709: if (defined $link) {
1710: $body->removeAttribute('link');
1711: $link = trim($link);
1712: $link =~ s/^x\s*//;
1713: $css .= ' a:link { color:'.$link.' }';
1714: $css .= "\n";
1715: }
1716: if (defined $alink) {
1717: $body->removeAttribute('alink');
1718: $alink = trim($alink);
1719: $alink =~ s/^x\s*//;
1720: $css .= ' a:active { color:'.$alink.' }';
1721: $css .= "\n";
1722: }
1723: if (defined $vlink) {
1724: $body->removeAttribute('vlink');
1725: $vlink = trim($vlink);
1726: $vlink =~ s/^x\s*//;
1727: $css .= ' a:visited { color:'.$vlink.' }';
1728: $css .= "\n";
1729: }
1730: $css .= ' ';
1731: $style->appendChild($doc->createTextNode($css));
1732: }
1733: if (scalar(keys %new_properties) > 0) {
1734: set_css_properties($body, \%new_properties);
1735: } elsif (!$body->hasAttributes) {
1736: $body->parentNode->removeChild($body);
1737: }
1738: }
1739: }
1740:
1741: # replaces <div align="center"> by <div style="text-align:center;">
1742: # also for p and h1..h6
1743: sub fix_align_attribute {
1744: my ($root) = @_;
1745: my @nodes = $root->getElementsByTagName('div');
1746: push(@nodes, $root->getElementsByTagName('p'));
1747: for (my $i=1; $i<=6; $i++) {
1748: push(@nodes, $root->getElementsByTagName('h'.$i));
1749: }
1750: foreach my $node (@nodes) {
1751: my $align = $node->getAttribute('align');
1752: if (defined $align) {
1753: $node->removeAttribute('align');
1754: $align = trim($align);
1755: if ($align ne '' && !defined get_css_property($node, 'text-align')) {
1756: set_css_property($node, 'text-align', lc($align));
1757: }
1758: }
1759: }
1760: }
1761:
1762: # replace center by a div or remove it if there is a table inside
1763: sub replace_center {
1764: my ($root, $all_block) = @_;
1765: my $doc = $root->ownerDocument;
1766: my @centers = $root->getElementsByTagName('center');
1767: foreach my $center (@centers) {
1768: if ($center->getChildrenByTagName('table')->size() > 0) { # note: getChildrenByTagName is not DOM (LibXML specific)
1769: replace_by_children($center);
1770: } else {
1771: if ((!defined $center->previousSibling ||
1772: ($center->previousSibling->nodeType == XML_TEXT_NODE && $center->previousSibling->nodeValue =~ /^\s*$/ && !defined $center->previousSibling->previousSibling)) &&
1773: (!defined $center->nextSibling ||
1774: ($center->nextSibling->nodeType == XML_TEXT_NODE && $center->nextSibling->nodeValue =~ /^\s*$/ && !defined $center->nextSibling->nextSibling)) &&
1775: string_in_array(\@accepting_style, $center->parentNode->nodeName)) {
1776: # use CSS on the parent block and replace center by its children
1777: set_css_property($center->parentNode, 'text-align', 'center');
1778: replace_by_children($center);
1779: } else {
1780: # use p or div ? check if there is a block inside
1781: my $found_block = 0;
1782: for (my $child=$center->firstChild; defined $child; $child=$child->nextSibling) {
1783: if ($child->nodeType == XML_ELEMENT_NODE && string_in_array($all_block, $child->nodeName)) {
1784: $found_block = 1;
1785: last;
1786: }
1787: }
1788: my $new_node;
1789: if ($found_block) {
1790: $new_node = $doc->createElement('div');
1791: $new_node->setAttribute('style', 'text-align: center; margin: 0 auto');
1792: } else {
1793: $new_node = $doc->createElement('p');
1794: $new_node->setAttribute('style', 'text-align: center');
1795: }
1796: my $next;
1797: for (my $child=$center->firstChild; defined $child; $child=$next) {
1798: $next = $child->nextSibling;
1799: $center->removeChild($child);
1800: $new_node->appendChild($child);
1801: }
1802: $center->parentNode->replaceChild($new_node, $center);
1803: }
1804: }
1805: }
1806: }
1807:
1808: # replaces <nobr> by <span style="white-space:nowrap">
1809: sub replace_nobr {
1810: my ($root) = @_;
1811: my @nobrs = $root->getElementsByTagName('nobr');
1812: foreach my $nobr (@nobrs) {
1813: if (!defined $nobr->previousSibling && !defined $nobr->nextSibling &&
1814: string_in_array(\@accepting_style, $nobr->parentNode->nodeName)) {
1815: # use CSS on the parent block
1816: set_css_property($nobr->parentNode, 'white-space', 'nowrap');
1817: replace_by_children($nobr);
1818: } else {
1819: $nobr->setNodeName('span');
1820: $nobr->setAttribute('style', 'white-space:nowrap');
1821: }
1822: }
1823: }
1824:
1825: # removes notsolved tags in the case <hintgroup showoncorrect="no"><notsolved>...</notsolved></hintgroup>
1826: # and in the case <notsolved><hintgroup showoncorrect="no">...</hintgroup></notsolved>
1827: sub remove_useless_notsolved {
1828: my ($root) = @_;
1829: my @hintgroups = $root->getElementsByTagName('hintgroup');
1830: foreach my $hintgroup (@hintgroups) {
1831: my $showoncorrect = get_non_empty_attribute($hintgroup, 'showoncorrect');
1832: if (!defined $showoncorrect || $showoncorrect eq 'no') {
1833: my @notsolveds = $hintgroup->getElementsByTagName('notsolved');
1834: foreach my $notsolved (@notsolveds) {
1835: replace_by_children($notsolved);
1836: }
1837: }
1838: my $parent = $hintgroup->parentNode;
1839: if ($parent->nodeName eq 'notsolved' && scalar(@{$parent->nonBlankChildNodes()}) == 1) {
1840: replace_by_children($parent);
1841: }
1842: }
1843: }
1844:
1.9 damieng 1845: # Use <pre> for multi-line comments without elements.
1846: sub fix_comments {
1847: my ($root) = @_;
1848: my $doc = $root->ownerDocument;
1849: my @comments = $root->getElementsByTagName('comment');
1850: foreach my $comment (@comments) {
1851: my $first = $comment->firstChild;
1852: if (defined $first) {
1853: if ($first->nodeType == XML_TEXT_NODE && $first->nodeValue =~ /\n/ &&
1854: !defined $first->nextSibling) {
1855: my $pre = $doc->createElement('pre');
1856: $comment->removeChild($first);
1857: $comment->appendChild($pre);
1858: $pre->appendChild($first);
1859: }
1860: }
1861: }
1862: }
1863:
1.1 damieng 1864: # adds a paragraph inside if needed and calls fix_paragraph for all paragraphs (including new ones)
1865: sub fix_paragraphs_inside {
1866: my ($node, $all_block) = @_;
1867: # blocks in which paragrahs will be added:
1.8 damieng 1868: my @blocks_with_p = ('loncapa','library','problem','part','problemtype','window','block','while','postanswerdate','preduedate','languageblock','instructorcomment','togglebox','standalone','body','form');
1869: my @fix_p_if_br_or_p = (@responses,'foil','item','text','label','hintgroup','hintpart','hint','web','windowlink','div','li','dd','td','th','blockquote','solved','notsolved');
1.1 damieng 1870: if ((string_in_array(\@blocks_with_p, $node->nodeName) && paragraph_needed($node)) ||
1871: (string_in_array(\@fix_p_if_br_or_p, $node->nodeName) && paragraph_inside($node))) {
1872: # if non-empty, add paragraphs where needed between all br and remove br
1873: # (it would be easier to just put everything in a p and fix it afterwards, but there are performance issues
1874: # when a paragraph has many blocks directly inside)
1875: my $doc = $node->ownerDocument;
1876: my $p = undef;
1877: my @new_children = ();
1878: my $next;
1879: for (my $child=$node->firstChild; defined $child; $child=$next) {
1880: $next = $child->nextSibling;
1881: $node->removeChild($child);
1882: if ($child->nodeType == XML_ELEMENT_NODE && $child->nodeName eq 'br') {
1883: if (defined $p) {
1884: push(@new_children, $p);
1885: } else {
1886: push(@new_children, $doc->createElement('p'));
1887: }
1888: $p = undef;
1.11 damieng 1889: # ignore the next node if it is a br (the paragraph default margin will take as much space)
1890: # (ignoring whitespace)
1891: while (defined $next && $next->nodeType == XML_TEXT_NODE && $next->nodeValue =~ /^[ \t\f\n\r]*$/) {
1892: my $next2 = $next->nextSibling;
1893: $node->removeChild($next);
1894: $next = $next2;
1895: }
1896: if (defined $next && $next->nodeType == XML_ELEMENT_NODE && $next->nodeName eq 'br') {
1897: my $next2 = $next->nextSibling;
1898: $node->removeChild($next);
1899: $next = $next2;
1900: }
1.1 damieng 1901: } elsif ($child->nodeType == XML_ELEMENT_NODE && string_in_array(\@inline_like_block, $child->nodeName)) {
1902: # inline_like_block: use the paragraph if there is one, otherwise do not create one
1903: if (defined $p) {
1904: $p->appendChild($child);
1905: } else {
1906: push(@new_children, $child);
1907: }
1908: } elsif ($child->nodeType == XML_ELEMENT_NODE && string_in_array($all_block, $child->nodeName)) {
1909: # these children are blocks and should not be in a paragraph
1910: if (defined $p) {
1911: push(@new_children, $p);
1912: $p = undef;
1913: }
1914: push(@new_children, $child);
1915: } elsif ($child->nodeType == XML_TEXT_NODE && $child->nodeValue =~ /^[ \t\f\n\r]*$/) {
1916: # blank text: add to paragraph if there is one and there is a next node, otherwise keep out of the paragraph
1917: if (defined $p) {
1918: if (defined $next) {
1919: $p->appendChild($child);
1920: } else {
1921: push(@new_children, $p);
1922: $p = undef;
1923: push(@new_children, $child);
1924: }
1925: } else {
1926: push(@new_children, $child);
1927: }
1928: } elsif ($child->nodeType == XML_TEXT_NODE ||
1929: $child->nodeType == XML_ELEMENT_NODE || $child->nodeType == XML_CDATA_SECTION_NODE ||
1930: $child->nodeType == XML_ENTITY_NODE || $child->nodeType == XML_ENTITY_REF_NODE) {
1931: # these children require a paragraph
1932: if (!defined $p) {
1933: $p = $doc->createElement('p');
1934: }
1935: $p->appendChild($child);
1936: } else {
1937: # these children do not require a paragraph (XML comments, PI)
1938: # -> do not move them in a new paragraph
1939: if (defined $p) {
1940: push(@new_children, $p);
1941: $p = undef;
1942: }
1943: push(@new_children, $child);
1944: }
1945: }
1946: if (defined $p) {
1947: push(@new_children, $p);
1948: }
1949: foreach my $child (@new_children) {
1950: $node->appendChild($child);
1951: }
1952: }
1953: # now fix the paragraphs everywhere, so that all inline nodes are inside a paragraph, and block nodes are outside
1954: my $next;
1955: for (my $child=$node->firstChild; defined $child; $child=$next) {
1956: $next = $child->nextSibling;
1957: if ($child->nodeType == XML_ELEMENT_NODE && defined $child->firstChild) {
1958: if ($child->nodeName eq 'p') {
1959: fix_paragraph($child, $all_block);
1960: } else {
1961: fix_paragraphs_inside($child, $all_block);
1962: }
1963: }
1964: }
1965: }
1966:
1967: # returns 1 if a paragraph is needed inside this node (assuming the parent can have paragraphs)
1968: sub paragraph_needed {
1969: my ($node) = @_;
1970: for (my $child=$node->firstChild; defined $child; $child=$child->nextSibling) {
1971: if (($child->nodeType == XML_TEXT_NODE && $child->nodeValue !~ /^\s*$/) ||
1972: ($child->nodeType == XML_ELEMENT_NODE && !string_in_array(\@inline_like_block, $child->nodeName)) ||
1973: $child->nodeType == XML_CDATA_SECTION_NODE ||
1974: $child->nodeType == XML_ENTITY_NODE || $child->nodeType == XML_ENTITY_REF_NODE) {
1975: return(1);
1976: }
1977: }
1978: return(0);
1979: }
1980:
1981: # returns 1 if there is a paragraph or br in a child of this node, or inside an inline child
1982: sub paragraph_inside {
1983: my ($node) = @_;
1984: # inline elements that can be split in half if there is a paragraph inside (currently all HTML):
1985: # (also used in first_block below)
1986: my @splitable_inline = ('span', 'a', 'strong', 'em' , 'b', 'i', 'sup', 'sub', 'code', 'kbd', 'samp', 'tt', 'ins', 'del', 'var', 'small', 'big', 'font', 'u');
1987: for (my $child=$node->firstChild; defined $child; $child=$child->nextSibling) {
1988: if ($child->nodeType == XML_ELEMENT_NODE) {
1989: my $name = $child->nodeName;
1990: if ($name eq 'p' || $name eq 'br') {
1991: return(1);
1992: } elsif (string_in_array(\@splitable_inline, $name)) {
1993: if (paragraph_inside($child)) {
1994: return(1);
1995: }
1996: }
1997: }
1998: }
1999: return(0);
2000: }
2001:
2002: # fixes paragraphs inside paragraphs (without a block in-between)
2003: sub fix_paragraph {
2004: my ($p, $all_block) = @_;
2005: my $loop_right = 1; # this loops is to avoid out of memory errors with recurse, see below
2006: while ($loop_right) {
2007: $loop_right = 0;
2008: my $block = find_first_block($p, $all_block);
2009: if (defined $block) {
2010: my $trees = clone_ancestor_around_node($p, $block);
2011: my $doc = $p->ownerDocument;
2012: my $replacement = $doc->createDocumentFragment();
2013: my $left = $trees->{'left'};
2014: my $middle = $trees->{'middle'};
2015: my $right = $trees->{'right'};
2016: my $left_needs_p = 0; # 1 if it needs a paragraph (used to replace br later)
2017:
2018: if (defined $left) {
2019: # fix paragraphs inside, in case one of the descendants can have paragraphs inside (like numericalresponse/hintgroup):
2020: for (my $child=$left->firstChild; defined $child; $child=$child->nextSibling) {
2021: if ($child->nodeType == XML_ELEMENT_NODE) {
2022: fix_paragraphs_inside($child, $all_block);
2023: }
2024: }
2025: if (!paragraph_needed($left)) {
2026: # this was just blank text, comments or inline responses, it should not create a new paragraph
2027: my $next;
2028: for (my $child=$left->firstChild; defined $child; $child=$next) {
2029: $next = $child->nextSibling;
2030: $left->removeChild($child);
2031: $replacement->appendChild($child);
2032: }
2033: } else {
2034: $left_needs_p = 1;
2035: $replacement->appendChild($left);
2036: }
2037: }
2038:
2039: my $n = $middle->firstChild;
2040: while (defined $n) {
2041: if ($n->nodeType == XML_ELEMENT_NODE && (string_in_array($all_block, $n->nodeName) || $n->nodeName eq 'br')) {
2042: if ($n->nodeName eq 'p') {
2043: my $parent = $n->parentNode;
2044: # first apply recursion
2045: fix_paragraph($n, $all_block);
2046: # now the p might have been replaced by several nodes, which should replace the initial p
2047: my $next_block;
2048: for (my $block=$parent->firstChild; defined $block; $block=$next_block) {
2049: $next_block = $block->nextSibling;
2050: if ($block->nodeName eq 'p') {
2051: $parent->removeChild($block);
2052: # for each parent before $middle, clone in-between the p and its children (to preserve the styles)
2053: if (defined $block->firstChild) {
2054: for (my $p=$parent; $p!=$middle; $p=$p->parentNode) {
2055: my $newp = $p->cloneNode(0);
2056: my $next;
2057: for (my $child=$block->firstChild; defined $child; $child=$next) {
2058: $next = $child->nextSibling;
2059: $block->removeChild($child);
2060: $newp->appendChild($child);
2061: }
2062: $block->appendChild($newp);
2063: }
2064: }
2065: }
2066: $replacement->appendChild($block);
2067: }
2068: } else {
2069: # replace the whole p by this block, forgetting about intermediate inline elements
2070: $n->parentNode->removeChild($n);
2071: if ($n->nodeName eq 'br') {
2072: # replace a br by a paragraph if there was nothing before in the paragraph,
2073: # otherwise remove it because it already broke the paragraph in half
2074: if (!defined $left || !$left_needs_p) {
2075: $replacement->appendChild($middle);
2076: }
1.11 damieng 2077: # ignore the next node if it is a br (the paragraph default margin will take as much space)
2078: my $first_right;
2079: if (defined $right) {
2080: $first_right = $right->firstChild;
2081: # ignore non-nbsp whitespace
2082: while (defined $first_right && $first_right->nodeType == XML_TEXT_NODE &&
2083: $first_right->nodeValue =~ /^[ \t\f\n\r]*$/) {
2084: $first_right = $first_right->nextSibling;
2085: }
2086: }
2087: if (defined $first_right && $first_right->nodeType == XML_ELEMENT_NODE &&
2088: $first_right->nodeName eq 'br') {
2089: $right->removeChild($first_right);
2090: }
1.1 damieng 2091: } else {
2092: fix_paragraphs_inside($n, $all_block);
2093: $replacement->appendChild($n);
2094: }
2095: }
2096: last;
2097: }
2098: $n = $n->firstChild;
2099: if (defined $n && defined $n->nextSibling) {
2100: die "Error in post_xml.fix_paragraph: block not found";
2101: }
2102: }
2103:
2104: if (defined $right) {
2105: if ($block->nodeName eq 'p') {
2106: # remove attributes on the right paragraph
2107: my @attributelist = $right->attributes();
2108: foreach my $att (@attributelist) {
2109: $right->removeAttribute($att->nodeName);
2110: }
2111: }
2112: if ($right->firstChild->nodeType == XML_TEXT_NODE && $right->firstChild->nodeValue =~ /^[ \t\f\n\r]*$/) {
2113: # remove the first text node with whitespace only from the p, it should not trigger the creation of a p
2114: # (but take nbsp into account, so we should not use \s here)
2115: my $first = $right->firstChild;
2116: $right->removeChild($first);
2117: $replacement->appendChild($first);
2118: }
2119: if (defined $right->firstChild) {
2120: if (paragraph_needed($right)) {
2121: $replacement->appendChild($right);
2122: #fix_paragraph($right, $all_block); This is taking way too much memory for blocks with many children
2123: # -> loop instead of recurse
2124: $loop_right = 1;
2125: } else {
2126: # this was just blank text, comments or inline responses, it should not create a new paragraph
2127: my $next;
2128: for (my $child=$right->firstChild; defined $child; $child=$next) {
2129: $next = $child->nextSibling;
2130: $right->removeChild($child);
2131: $replacement->appendChild($child);
2132: # fix paragraphs inside, in case one of the descendants can have paragraphs inside (like numericalresponse/hintgroup):
2133: if ($child->nodeType == XML_ELEMENT_NODE) {
2134: fix_paragraphs_inside($child, $all_block);
2135: }
2136: }
2137: }
2138: }
2139: }
2140:
2141: $p->parentNode->replaceChild($replacement, $p);
2142:
2143: if ($loop_right) {
2144: $p = $right;
2145: }
2146:
2147: } else {
2148: # fix paragraphs inside, in case one of the descendants can have paragraphs inside (like numericalresponse/hintgroup):
2149: my $next;
2150: for (my $child=$p->firstChild; defined $child; $child=$next) {
2151: $next = $child->nextSibling;
2152: if ($child->nodeType == XML_ELEMENT_NODE) {
2153: fix_paragraphs_inside($child, $all_block);
2154: }
2155: }
2156: }
2157: }
2158: }
2159:
2160: sub find_first_block {
2161: my ($node, $all_block) = @_;
2162: # inline elements that can be split in half if there is a paragraph inside (currently all HTML):
2163: my @splitable_inline = ('span', 'a', 'strong', 'em' , 'b', 'i', 'sup', 'sub', 'code', 'kbd', 'samp', 'tt', 'ins', 'del', 'var', 'small', 'big', 'font', 'u');
2164: for (my $child=$node->firstChild; defined $child; $child=$child->nextSibling) {
2165: if ($child->nodeType == XML_ELEMENT_NODE) {
2166: if (string_in_array($all_block, $child->nodeName) || $child->nodeName eq 'br') {
2167: return($child);
2168: }
2169: if (string_in_array(\@splitable_inline, $child->nodeName)) {
2170: my $block = find_first_block($child, $all_block);
2171: if (defined $block) {
2172: return($block);
2173: }
2174: }
2175: }
2176: }
2177: return(undef);
2178: }
2179:
2180: # Creates clones of the ancestor containing the descendants before the node, at the node, and after the node.
2181: # returns a hash with: left, middle, right (left and right can be undef)
2182: sub clone_ancestor_around_node {
2183: my ($ancestor, $node) = @_;
2184: my $middle_node;
2185: my ($left, $middle, $right);
2186: for (my $child=$ancestor->firstChild; defined $child; $child=$child->nextSibling) {
2187: if ($child == $node || is_ancestor_of($child, $node)) {
2188: $middle_node = $child;
2189: last;
2190: }
2191: }
2192: if (!defined $middle_node) {
2193: die "error in split_ancestor_around_node: middle not found";
2194: }
2195: if (defined $middle_node->previousSibling) {
2196: $left = $ancestor->cloneNode(0);
2197: for (my $child=$ancestor->firstChild; $child != $middle_node; $child=$child->nextSibling) {
2198: $left->appendChild($child->cloneNode(1));
2199: }
2200: }
2201: $middle = $ancestor->cloneNode(0);
2202: if ($middle_node == $node) {
2203: $middle->appendChild($middle_node->cloneNode(1));
2204: } else {
2205: my $subres = clone_ancestor_around_node($middle_node, $node);
2206: my $subleft = $subres->{'left'};
2207: if (defined $subleft) {
2208: if (!defined $left) {
2209: $left = $ancestor->cloneNode(0);
2210: }
2211: $left->appendChild($subleft);
2212: }
2213: $middle->appendChild($subres->{'middle'});
2214: my $subright = $subres->{'right'};
2215: if (defined $subright) {
2216: $right = $ancestor->cloneNode(0);
2217: $right->appendChild($subright);
2218: }
2219: }
2220: if (defined $middle_node->nextSibling) {
2221: if (!defined $right) {
2222: $right = $ancestor->cloneNode(0);
2223: }
2224: for (my $child=$middle_node->nextSibling; defined $child; $child=$child->nextSibling) {
2225: $right->appendChild($child->cloneNode(1));
2226: }
2227: }
2228: my %result = ();
2229: $result{'left'} = $left;
2230: $result{'middle'} = $middle;
2231: $result{'right'} = $right;
2232: return(\%result);
2233: }
2234:
2235: sub is_ancestor_of {
2236: my ($n1, $n2) = @_;
2237: my $n = $n2->parentNode;
2238: while (defined $n) {
2239: if ($n == $n1) {
2240: return(1);
2241: }
2242: $n = $n->parentNode;
2243: }
2244: return(0);
2245: }
2246:
2247: # removes empty style elements and replaces the ones with only whitespaces inside by their content
2248: # also remove hints that have become empty after empty style removal.
2249: sub remove_empty_style {
2250: my ($root) = @_;
2251: # actually, preserve some elements like ins when they have whitespace, only remove if they are empty
2252: my @remove_if_empty = ('span', 'strong', 'em' , 'b', 'i', 'sup', 'sub', 'code', 'kbd', 'samp', 'tt', 'ins', 'del', 'var', 'small', 'big', 'font', 'u', 'hint');
2253: my @remove_if_blank = ('span', 'strong', 'em' , 'b', 'i', 'sup', 'sub', 'tt', 'var', 'small', 'big', 'font', 'u', 'hint');
2254: foreach my $name (@remove_if_empty) {
2255: my @nodes = $root->getElementsByTagName($name);
2256: while (scalar(@nodes) > 0) {
2257: my $node = pop(@nodes);
2258: if (!defined $node->firstChild) {
2259: my $parent = $node->parentNode;
2260: if (defined $node->previousSibling && $node->previousSibling->nodeType == XML_TEXT_NODE &&
2261: $node->previousSibling->nodeValue =~ /\$\S*$/) {
2262: # case $a<sup></sup>x
2263: my $value = $node->previousSibling->nodeValue;
2264: $value =~ s/\$(\S*)$/\$\{$1\}/;
2265: $node->previousSibling->setData($value);
2266: }
2267: $parent->removeChild($node);
2268: $parent->normalize();
2269: # now that we removed the node, check if the parent has become an empty style, and so on
2270: while (defined $parent && string_in_array(\@remove_if_empty, $parent->nodeName) && !defined $parent->firstChild) {
2271: my $grandparent = $parent->parentNode;
2272: $grandparent->removeChild($parent);
2273: remove_reference_from_array(\@nodes, $parent);
2274: $parent = $grandparent;
2275: }
2276: }
2277: }
2278: }
2279: foreach my $name (@remove_if_blank) {
2280: my @nodes = $root->getElementsByTagName($name);
2281: while (scalar(@nodes) > 0) {
2282: my $node = pop(@nodes);
2283: if (defined $node->firstChild && !defined $node->firstChild->nextSibling && $node->firstChild->nodeType == XML_TEXT_NODE) {
2284: # NOTE: careful, with UTF-8, \s matches non-breaking spaces and we want to preserve these
2285: if ($node->firstChild->nodeValue =~ /^[\t\n\f\r ]*$/) {
2286: my $parent = $node->parentNode;
2287: replace_by_children($node);
2288: $parent->normalize();
2289: # now that we removed the node, check if the parent has become a style with only whitespace, and so on
2290: while (defined $parent && string_in_array(\@remove_if_blank, $parent->nodeName) &&
2291: (!defined $parent->firstChild ||
2292: (!defined $parent->firstChild->nextSibling && $parent->firstChild->nodeType == XML_TEXT_NODE &&
2293: $parent->firstChild->nodeValue =~ /^^[\t\n\f\r ]*$/))) {
2294: my $grandparent = $parent->parentNode;
2295: replace_by_children($parent);
2296: remove_reference_from_array(\@nodes, $parent);
2297: $parent = $grandparent;
2298: }
2299: }
2300: }
2301: }
2302: }
2303: }
2304:
2305: # remove whitespace inside LON-CAPA elements that have an empty content-model (HTML ones are handled by html_to_xml)
2306: sub fix_empty_lc_elements {
2307: my ($node) = @_;
2308: my @lcempty = ('arc','axis','backgroundplot','drawoptionlist','drawvectorsum','fill','functionplotrule','functionplotvectorrule','functionplotvectorsumrule','hiddenline','hiddensubmission','key','line','location','organicstructure','parameter','plotobject','plotvector','responseparam','spline','textline');
2309: if (string_in_array(\@lcempty, $node->nodeName)) {
2310: if (defined $node->firstChild && !defined $node->firstChild->nextSibling &&
2311: $node->firstChild->nodeType == XML_TEXT_NODE && $node->firstChild->nodeValue =~ /^\s*$/) {
2312: $node->removeChild($node->firstChild);
2313: }
2314: if (defined $node->firstChild) {
2315: if ($warnings) {
2316: print "Warning: a ".$node->nodeName." has something inside\n";
2317: }
2318: }
2319: return;
2320: }
2321: for (my $child=$node->firstChild; defined $child; $child=$child->nextSibling) {
2322: if ($child->nodeType == XML_ELEMENT_NODE) {
2323: fix_empty_lc_elements($child);
2324: }
2325: }
2326: }
2327:
1.10 damieng 2328: # remove consecutive empty paragraphs (they will not show anyway)
2329: sub reduce_empty_p {
2330: my ($node) = @_;
2331: my $next;
2332: for (my $child=$node->firstChild; defined $child; $child=$next) {
2333: $next = $child->nextSibling;
2334: while (defined $next && $next->nodeType == XML_TEXT_NODE && $next->nodeValue =~ /^[ \t\f\n\r]*$/) {
2335: $next = $next->nextSibling;
2336: }
2337: if ($child->nodeType == XML_ELEMENT_NODE && $child->nodeName eq 'p' && defined $next &&
2338: $next->nodeType == XML_ELEMENT_NODE && $next->nodeName eq 'p') {
2339: my $first = $child->firstChild;
2340: if (!defined $first || (!defined $first->nextSibling &&
2341: $first->nodeType == XML_TEXT_NODE && $first->nodeValue =~ /^[ \t\f\n\r]*$/)) {
2342: $first = $next->firstChild;
2343: if (!defined $first || (!defined $first->nextSibling &&
2344: $first->nodeType == XML_TEXT_NODE && $first->nodeValue =~ /^[ \t\f\n\r]*$/)) {
2345: $node->removeChild($child);
2346: }
2347: }
2348: }
2349: if ($child->nodeType == XML_ELEMENT_NODE) {
2350: reduce_empty_p($child);
2351: }
2352: }
2353: }
2354:
1.1 damieng 2355: # turn some attribute values into lowercase when they should be
2356: sub lowercase_attribute_values {
2357: my ($root) = @_;
2358: my @with_yesno = (['radiobuttonresponse', ['randomize']],
2359: ['optionresponse', ['randomize']],
2360: ['matchresponse', ['randomize']],
2361: ['itemgroup', ['randomize']],
2362: ['rankresponse', ['randomize']],
2363: ['functionplotresponse', ['xaxisvisible', 'yaxisvisible', 'gridvisible']],
2364: ['backgroundplot', ['fixed']],
2365: ['drawvectorsum', ['showvalue']],
2366: ['textline', ['readonly']],
2367: ['hint', ['showoncorrect']],
2368: ['body', ['dir']],
2369: ['img', ['encrypturl']],
2370: ['form', ['method']],
2371: ['input', ['type']]
2372: );
2373: foreach my $el_attributes (@with_yesno) {
2374: my $el_name = $el_attributes->[0];
2375: my @elements = $root->getElementsByTagName($el_name);
2376: foreach my $element (@elements) {
2377: my $att_list = $el_attributes->[1];
2378: foreach my $att_name (@$att_list) {
2379: my $att_value = $element->getAttribute($att_name);
2380: if (!defined $att_value) {
2381: next;
2382: }
2383: if ($att_value eq 'yes' || $att_value eq 'no') {
2384: next;
2385: }
2386: if ($att_value =~ /\s*yes\s*/i) {
2387: $element->setAttribute($att_name, 'yes');
2388: } elsif ($att_value =~ /\s*no\s*/i) {
2389: $element->setAttribute($att_name, 'no');
2390: }
2391: }
2392: }
2393: }
2394: }
2395:
2396: # fixes spelling mistakes for numericalresponse/@unit
2397: sub replace_numericalresponse_unit_attribute {
2398: my ($root) = @_;
2399: my @numericalresponses = $root->getElementsByTagName('numericalresponse');
2400: foreach my $numericalresponse (@numericalresponses) {
2401: if (defined $numericalresponse->getAttribute('units') && !defined $numericalresponse->getAttribute('unit')) {
2402: $numericalresponse->setAttribute('unit', $numericalresponse->getAttribute('units'));
2403: $numericalresponse->removeAttribute('units');
2404: }
2405: }
2406:
2407: }
2408:
2409: # Replaces &format and &prettyprint by <num> whenever possible.
2410: # Also replaces &chemparse by <chem>.
2411: # If the function call is enclosed in <display>, the <display> element is removed.
2412: sub replace_functions_by_elements {
2413: my ($root) = @_;
2414: my $doc = $root->ownerDocument;
2415: my @preserve = ('script','answer','parse','m','tm','dtm','numericalhintscript'); # display is handled later
2416: my @all = $root->getElementsByTagName('*');
2417: foreach my $element (@all) {
2418: if (string_in_array(\@preserve, $element->nodeName)) {
2419: next;
2420: }
2421: my $changed = 0;
2422: my $next;
2423: for (my $child=$element->firstChild; defined $child; $child=$next) {
2424: $next = $child->nextSibling;
2425: if ($child->nodeType == XML_TEXT_NODE) {
2426: my $value = $child->nodeValue;
2427: if ($value =~ /^(.*)&(?:format|prettyprint)\((\$\{?[a-zA-Z0-9]*\}?(?:\[[^\]]*\])?|[0-9.]+)\s?,\s?(["'][,.\$]?[0-9][eEfFgGsS]["']|\$[a-zA-Z0-9]*)\)(.*)$/s) {
2428: # NOTE: we don't check for &prettyprint's 3rd argument (target), but it has not been seen outside of script elements.
2429: # NOTE: the format options ',' and '$' are not supported by &format in current LON-CAPA since rev 1.81 of default_homework.lcpm,
2430: # but are supported by &prettyprint;
2431: # if we use (like current LON-CAPA) &prettyprint for <num> implementation, it will change a few resulting documents
2432: # (by making them display something they were probably intended to display, but which did not).
2433: # Usage of <num> with &prettyprint instead of &format might also change the display when there is an exponent.
2434: my $before = $1;
2435: my $number = $2;
2436: my $format = $3;
2437: my $after = $4;
2438: $format =~ s/^['"]|['"]$//g;
2439: # do not change this if the parent is <display> and there are other things before or after &format
2440: if ($element->nodeName eq 'display' && (defined $child->previousSibling || defined $next ||
2441: $before !~ /^\s*$/ || $after !~ /^\s*$/)) {
2442: last;
2443: }
2444: my $replacement = $doc->createDocumentFragment();
2445: my $num = $doc->createElement('num');
2446: $num->setAttribute('format', $format);
2447: $num->appendChild($doc->createTextNode($number));
2448: if (length($before) > 0) {
2449: $replacement->appendChild($doc->createTextNode($before));
2450: }
2451: $replacement->appendChild($num);
2452: if (length($after) > 0) {
2453: $replacement->appendChild($doc->createTextNode($after));
2454: }
2455: $element->replaceChild($replacement, $child);
2456: $changed = 1;
2457: $next = $element->firstChild; # start over, there might be another &format in the same text node
2458: } elsif ($value =~ /^(.*)&chemparse\(([^'"()]*|'[^']*'|"[^"]*")\)(.*)$/s) {
2459: my $before = $1;
2460: my $reaction = $2;
2461: my $after = $3;
2462: $reaction =~ s/^'(.*)'$/$1/;
2463: $reaction =~ s/^"(.*)"$/$1/;
2464: if ($element->nodeName eq 'display' && (defined $child->previousSibling || defined $next ||
2465: $before !~ /^\s*$/ || $after !~ /^\s*$/)) {
2466: last;
2467: }
2468: my $replacement = $doc->createDocumentFragment();
2469: my $chem = $doc->createElement('chem');
2470: $chem->appendChild($doc->createTextNode($reaction));
2471: if (length($before) > 0) {
2472: $replacement->appendChild($doc->createTextNode($before));
2473: }
2474: $replacement->appendChild($chem);
2475: if (length($after) > 0) {
2476: $replacement->appendChild($doc->createTextNode($after));
2477: }
2478: $element->replaceChild($replacement, $child);
2479: $changed = 1;
2480: $next = $element->firstChild;
2481: }
2482: }
2483: }
2484: if ($changed && $element->nodeName eq 'display') {
2485: my $first = $element->firstChild;
2486: if ($first->nodeType == XML_ELEMENT_NODE && string_in_array(['num','chem'], $first->nodeName) &&
2487: !defined $first->nextSibling) {
2488: # remove useless display element
2489: replace_by_children($element);
2490: }
2491: }
2492: }
2493: }
2494:
2495: # pretty-print using im-memory DOM tree
2496: sub pretty {
2497: my ($node, $all_block, $indent_level) = @_;
2498: my $doc = $node->ownerDocument;
2499: $indent_level ||= 0;
2500: my $type = $node->nodeType;
2501: if ($type == XML_ELEMENT_NODE) {
2502: my $name = $node->nodeName;
1.6 damieng 2503: if (string_in_array(\@preserve_elements, $name)) {
2504: # remove newlines at the beginning and the end of preserve elements
2505: if (defined $node->firstChild && ($node->firstChild->nodeType == XML_TEXT_NODE ||
2506: $node->firstChild->nodeType == XML_CDATA_SECTION_NODE)) {
2507: my $text = $node->firstChild->nodeValue;
2508: $text =~ s/^\n+//;
2509: if ($text eq '') {
2510: $node->removeChild($node->firstChild);
2511: } else {
2512: $node->firstChild->setData($text);
2513: }
2514: }
2515: if (defined $node->lastChild && ($node->lastChild->nodeType == XML_TEXT_NODE ||
2516: $node->lastChild->nodeType == XML_CDATA_SECTION_NODE)) {
2517: my $text = $node->lastChild->nodeValue;
2518: $text =~ s/\n+$//;
2519: if ($text eq '') {
2520: $node->removeChild($node->lastChild);
2521: } else {
2522: $node->lastChild->setData($text);
2523: }
2524: }
2525: } elsif (string_in_array($all_block, $name) || string_in_array(\@inline_like_block, $name)) {
1.1 damieng 2526: # make sure there is a newline at the beginning and at the end if there is anything inside
2527: if (defined $node->firstChild && !string_in_array(\@no_newline_inside, $name)) {
2528: my $first = $node->firstChild;
2529: if ($first->nodeType == XML_TEXT_NODE) {
2530: my $text = $first->nodeValue;
2531: if ($text !~ /^ *\n/) {
2532: $first->setData("\n" . $text);
2533: }
2534: } else {
2535: $node->insertBefore($doc->createTextNode("\n"), $first);
2536: }
2537: my $last = $node->lastChild;
2538: if ($last->nodeType == XML_TEXT_NODE) {
2539: my $text = $last->nodeValue;
2540: if ($text !~ /\n *$/) {
2541: $last->setData($text . "\n");
2542: }
2543: } else {
2544: $node->appendChild($doc->createTextNode("\n"));
2545: }
2546: }
2547:
2548: # indent and make sure there is a newline before and after a block element
2549: my $newline_indent = "\n".(' ' x (2*($indent_level + 1)));
2550: my $newline_indent_last = "\n".(' ' x (2*$indent_level));
2551: my $next;
2552: for (my $child=$node->firstChild; defined $child; $child=$next) {
2553: $next = $child->nextSibling;
2554: if ($child->nodeType == XML_ELEMENT_NODE) {
2555: if (string_in_array($all_block, $child->nodeName) || string_in_array(\@inline_like_block, $child->nodeName)) {
2556: # make sure there is a newline before and after a block element
2557: if (defined $child->previousSibling && $child->previousSibling->nodeType == XML_TEXT_NODE) {
2558: my $prev = $child->previousSibling;
2559: my $text = $prev->nodeValue;
2560: if ($text !~ /\n *$/) {
2561: $prev->setData($text . $newline_indent);
2562: }
2563: } else {
2564: $node->insertBefore($doc->createTextNode($newline_indent), $child);
2565: }
2566: if (defined $next && $next->nodeType == XML_TEXT_NODE) {
2567: my $text = $next->nodeValue;
2568: if ($text !~ /^ *\n/) {
2569: $next->setData($newline_indent . $text);
2570: }
2571: } else {
2572: $node->insertAfter($doc->createTextNode($newline_indent), $child);
2573: }
2574: }
2575: pretty($child, $all_block, $indent_level+1);
2576: } elsif ($child->nodeType == XML_TEXT_NODE) {
2577: my $text = $child->nodeValue;
2578: # collapse newlines
2579: $text =~ s/\n([\t ]*\n)+/\n/g;
2580: # indent and remove spaces and tabs before newlines
2581: if (defined $next) {
2582: $text =~ s/[\t ]*\n[\t ]*/$newline_indent/ge;
2583: } else {
2584: $text =~ s/[\t ]*\n[\t ]*/$newline_indent/ge;
2585: $text =~ s/[\t ]*\n[\t ]*$/$newline_indent_last/e;
2586: }
2587: $child->setData($text);
2588: }
2589: }
2590:
2591: # removes whitespace at the beginning and end of p td, th and li (except for nbsp at the beginning)
2592: my @to_trim = ('p','td','th','li');
2593: if (string_in_array(\@to_trim, $name) && defined $node->firstChild && $node->firstChild->nodeType == XML_TEXT_NODE) {
2594: my $text = $node->firstChild->nodeValue;
2595: $text =~ s/^[ \t\f\n\r]*//;
2596: if ($text eq '') {
2597: $node->removeChild($node->firstChild);
2598: } else {
2599: $node->firstChild->setData($text);
2600: }
2601: }
2602: if (string_in_array(\@to_trim, $name) && defined $node->lastChild && $node->lastChild->nodeType == XML_TEXT_NODE) {
2603: my $text = $node->lastChild->nodeValue;
2604: $text =~ s/\s*$//;
2605: if ($text eq '') {
2606: $node->removeChild($node->lastChild);
2607: } else {
2608: $node->lastChild->setData($text);
2609: }
2610: }
2611: }
2612: }
2613: }
2614:
2615: sub replace_tm_dtm {
2616: my ($root) = @_;
2617: my $doc = $root->ownerDocument;
2618: my @elements = $root->getElementsByTagName('tm');
2619: push(@elements, $root->getElementsByTagName('dtm'));
2620: foreach my $element (@elements) {
2621: my $first = $element->firstChild;
2622: if (defined $first && $first->nodeType == XML_TEXT_NODE) {
2623: my $text = $first->nodeValue;
2624: if ($element->nodeName eq 'tm') {
2625: $first->setData('$'.$text.'$');
2626: } else {
2627: $first->setData('$$'.$text.'$$');
2628: }
2629: }
2630: $element->setNodeName('m');
2631: }
2632: }
2633:
2634:
2635: ######## utilities ########
2636:
2637: ##
2638: # Trims a string (really, this should be built-in in Perl, this is ridiculous, ugly and slow)
2639: # @param {string} s - the string to trim
2640: # @returns the trimmed string
2641: ##
2642: sub trim {
2643: my ($s) = @_;
2644: $s =~ s/^\s+//;
2645: $s =~ s/\s+$//;
2646: return($s);
2647: }
2648:
2649: ##
2650: # Tests if a string is in an array (using eq) (to avoid Smartmatch warnings with $value ~~ @array)
2651: # @param {Array<string>} array - reference to the array of strings
2652: # @param {string} value - the string to look for
2653: # @returns 1 if found, 0 otherwise
2654: ##
2655: sub string_in_array {
2656: my ($array, $value) = @_;
2657: # NOTE: would it be faster to use "any { $value eq $_ } @{$array}" from List::Util ?
2658: foreach my $v (@{$array}) {
2659: if ($v eq $value) {
2660: return 1;
2661: }
2662: }
2663: return 0;
2664: }
2665:
2666: ##
2667: # Tests if an object is in an array (using ==)
2668: # @param {Array<Object>} array - reference to the array of references
2669: # @param {Object} ref - the reference to look for
2670: # @returns 1 if found, 0 otherwise
2671: ##
2672: sub reference_in_array {
2673: my ($array, $ref) = @_;
2674: foreach my $v (@{$array}) {
2675: if ($v == $ref) {
2676: return 1;
2677: }
2678: }
2679: return 0;
2680: }
2681:
2682: ##
2683: # returns the index of a string in an array
2684: # @param {Array<Object>} array - reference to the array of strings
2685: # @param {string} s - the string to look for (using eq)
2686: # @returns the index if found, -1 otherwise
2687: ##
2688: sub index_of_string {
2689: my ($array, $s) = @_;
2690: for (my $i=0; $i<scalar(@{$array}); $i++) {
2691: if ($array->[$i] eq $s) {
2692: return $i;
2693: }
2694: }
2695: return -1;
2696: }
2697:
2698: ##
2699: # returns the index of a reference in an array
2700: # @param {Array<Object>} array - reference to the array of references
2701: # @param {Object} ref - the reference to look for
2702: # @returns the index if found, -1 otherwise
2703: ##
2704: sub index_of_reference {
2705: my ($array, $ref) = @_;
2706: for (my $i=0; $i<scalar(@{$array}); $i++) {
2707: if ($array->[$i] == $ref) {
2708: return $i;
2709: }
2710: }
2711: return -1;
2712: }
2713:
2714: ##
2715: # if found, removes a string from an array, otherwise do nothing
2716: # @param {Array<string>} array - reference to the array of string
2717: # @param {string} s - the string to look for (using eq)
2718: ##
2719: sub remove_string_from_array {
2720: my ($array, $s) = @_;
2721: my $index = index_of_string($array, $s);
2722: if ($index != -1) {
2723: splice(@$array, $index, 1);
2724: }
2725: }
2726:
2727: ##
2728: # if found, removes a reference from an array, otherwise do nothing
2729: # @param {Array<Object>} array - reference to the array of references
2730: # @param {Object} ref - the reference to look for
2731: ##
2732: sub remove_reference_from_array {
2733: my ($array, $ref) = @_;
2734: my $index = index_of_reference($array, $ref);
2735: if ($index != -1) {
2736: splice(@$array, $index, 1);
2737: }
2738: }
2739:
2740: ##
2741: # replaces a node by its children
2742: # @param {Node} node - the DOM node
2743: ##
2744: sub replace_by_children {
2745: my ($node) = @_;
2746: my $parent = $node->parentNode;
2747: my $next;
2748: my $previous;
2749: for (my $child=$node->firstChild; defined $child; $child=$next) {
2750: $next = $child->nextSibling;
2751: if ((!defined $previous || !defined $next) &&
2752: $child->nodeType == XML_TEXT_NODE && $child->nodeValue =~ /^\s*$/) {
2753: next; # do not keep first and last whitespace nodes
2754: } else {
2755: if (!defined $previous && $child->nodeType == XML_TEXT_NODE) {
2756: # remove whitespace at the beginning
2757: my $value = $child->nodeValue;
2758: $value =~ s/^\s+//;
2759: $child->setData($value);
2760: }
2761: if (!defined $next && $child->nodeType == XML_TEXT_NODE) {
2762: # and at the end
2763: my $value = $child->nodeValue;
2764: $value =~ s/\s+$//;
2765: $child->setData($value);
2766: }
2767: }
2768: $node->removeChild($child);
2769: $parent->insertBefore($child, $node);
2770: $previous = $child;
2771: }
2772: $parent->removeChild($node);
2773: }
2774:
2775: ##
2776: # returns the trimmed attribute value if the attribute exists and is not blank, undef otherwise
2777: # @param {Node} node - the DOM node
2778: # @param {string} attribute_name - the attribute name
2779: ##
2780: sub get_non_empty_attribute {
2781: my ($node, $attribute_name) = @_;
2782: my $value = $node->getAttribute($attribute_name);
2783: if (defined $value && $value !~ /^\s*$/) {
2784: $value = trim($value);
2785: return($value);
2786: }
2787: return(undef);
2788: }
2789:
2790: ##
2791: # Returns a CSS property value from the style attribute of the element, or undef if not defined
2792: # @param {Element} el - the DOM element
2793: # @param {string} property_name - the CSS property name
2794: ##
2795: sub get_css_property {
2796: my ($el, $property_name) = @_;
2797: my $style = $el->getAttribute('style');
2798: if (defined $style) {
2799: $style =~ s/^\s*;\s*//;
2800: $style =~ s/\s*;\s*$//;
2801: } else {
2802: $style = '';
2803: }
2804: my @pairs = split(';', $style);
2805: foreach my $pair (@pairs) {
2806: my @name_value = split(':', $pair);
2807: if (scalar(@name_value) != 2) {
2808: next;
2809: }
2810: my $name = trim($name_value[0]);
2811: my $value = trim($name_value[1]);
2812: if (lc($name) eq $property_name) {
2813: return($value); # return the first one found
2814: }
2815: }
2816: return(undef);
2817: }
2818:
2819: ##
2820: # Returns the reference to a hash CSS property name => value from the style attribute of the element.
2821: # Returns an empty list if the style attribute is not defined,
2822: # @param {Element} el - the DOM element
2823: # @return {Hash<string, string>} reference to the hash property name => property value
2824: ##
2825: sub get_css_properties {
2826: my ($el) = @_;
2827: my $style = $el->getAttribute('style');
2828: if (defined $style) {
2829: $style =~ s/^\s*;\s*//;
2830: $style =~ s/\s*;\s*$//;
2831: } else {
2832: $style = '';
2833: }
2834: my @pairs = split(';', $style);
2835: tie (my %hash, 'Tie::IxHash', ());
2836: foreach my $pair (@pairs) {
2837: my @name_value = split(':', $pair);
2838: if (scalar(@name_value) != 2) {
2839: next;
2840: }
2841: my $name = trim($name_value[0]);
2842: my $value = trim($name_value[1]);
2843: if (defined $hash{$name}) {
2844: # duplicate property in the style attribute: keep only the last one
2845: delete $hash{$name};
2846: }
2847: $hash{$name} = $value;
2848: }
2849: return(\%hash);
2850: }
2851:
2852: ##
2853: # Sets a CSS property in the style attribute of an element
2854: # @param {Element} el - the DOM element
2855: # @param {string} property_name - the CSS property name
2856: # @param {string} property_value - the CSS property value
2857: ##
2858: sub set_css_property {
2859: my ($el, $property_name, $property_value) = @_;
2860: my $hash_ref = { $property_name => $property_value };
2861: set_css_properties($el, $hash_ref);
2862: }
2863:
2864: ##
2865: # Sets several CSS properties in the style attribute of an element
2866: # @param {Element} el - the DOM element
2867: # @param {Hash<string, string>} properties - reference to the hash property name => property value
2868: ##
2869: sub set_css_properties {
2870: my ($el, $properties) = @_;
2871: my $hash = get_css_properties($el);
2872: foreach my $property_name (keys %$properties) {
2873: my $property_value = $properties->{$property_name};
2874: if (defined $hash->{$property_name}) {
2875: delete $hash->{$property_name}; # to add the new one at the end
2876: }
2877: $hash->{$property_name} = $property_value;
2878: }
2879: my $style = '';
2880: foreach my $key (keys %$hash) {
2881: $style .= $key.':'.$hash->{$key}.'; ';
2882: }
2883: $style =~ s/; $//;
2884: $el->setAttribute('style', $style);
2885: }
2886:
2887: 1;
2888: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to post_xml.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework / cleanxml