File:
[LON-CAPA] /
loncom /
homework /
CAPA-converter /
conversion_wrapper /
cnvprb
Revision
1.1:
download - view:
text,
annotated -
select for diffs
Wed Mar 20 18:15:00 2002 UTC (22 years, 4 months ago) by
albertel
Branches:
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_X,
version_2_7_99_1,
version_2_7_99_0,
version_2_7_1,
version_2_7_0,
version_2_6_X,
version_2_6_99_1,
version_2_6_99_0,
version_2_6_3,
version_2_6_2,
version_2_6_1,
version_2_6_0,
version_2_5_X,
version_2_5_99_1,
version_2_5_99_0,
version_2_5_2,
version_2_5_1,
version_2_5_0,
version_2_4_X,
version_2_4_99_0,
version_2_4_2,
version_2_4_1,
version_2_4_0,
version_2_3_X,
version_2_3_99_0,
version_2_3_2,
version_2_3_1,
version_2_3_0,
version_2_2_X,
version_2_2_99_1,
version_2_2_99_0,
version_2_2_2,
version_2_2_1,
version_2_2_0,
version_2_1_X,
version_2_1_99_3,
version_2_1_99_2,
version_2_1_99_1,
version_2_1_99_0,
version_2_1_3,
version_2_1_2,
version_2_1_1,
version_2_1_0,
version_2_12_X,
version_2_11_X,
version_2_11_5,
version_2_11_4_uiuc,
version_2_11_4_msu,
version_2_11_4,
version_2_11_3_uiuc,
version_2_11_3_msu,
version_2_11_3,
version_2_11_2_uiuc,
version_2_11_2_msu,
version_2_11_2_educog,
version_2_11_2,
version_2_11_1,
version_2_11_0_RC3,
version_2_11_0_RC2,
version_2_11_0_RC1,
version_2_11_0,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
version_2_0_X,
version_2_0_99_1,
version_2_0_2,
version_2_0_1,
version_2_0_0,
version_1_99_3,
version_1_99_2,
version_1_99_1_tmcc,
version_1_99_1,
version_1_99_0_tmcc,
version_1_99_0,
version_1_3_X,
version_1_3_3,
version_1_3_2,
version_1_3_1,
version_1_3_0,
version_1_2_X,
version_1_2_99_1,
version_1_2_99_0,
version_1_2_1,
version_1_2_0,
version_1_1_X,
version_1_1_99_5,
version_1_1_99_4,
version_1_1_99_3,
version_1_1_99_2,
version_1_1_99_1,
version_1_1_99_0,
version_1_1_3,
version_1_1_2,
version_1_1_1,
version_1_1_0,
version_1_0_99_3,
version_1_0_99_2,
version_1_0_99_1,
version_1_0_99,
version_1_0_3,
version_1_0_2,
version_1_0_1,
version_1_0_0,
version_0_99_5,
version_0_99_4,
version_0_99_3,
version_0_99_2,
version_0_99_1,
version_0_99_0,
version_0_6_2,
version_0_6,
version_0_5_1,
version_0_5,
loncapaMITrelate_1,
language_hyphenation_merge,
language_hyphenation,
conference_2003,
bz6209-base,
bz6209,
bz5969,
bz2851,
PRINT_INCOMPLETE_base,
PRINT_INCOMPLETE,
HEAD,
GCI_3,
GCI_2,
GCI_1,
BZ5971-printing-apage,
BZ5434-fox,
BZ4492-merge,
BZ4492-feature_horizontal_radioresponse,
BZ4492-feature_Support_horizontal_radioresponse,
BZ4492-Support_horizontal_radioresponse
- adding Ohio Universities CAPA -> LON-CAPA cleanup scripts
1: #!/usr/bin/perl
2: #
3: # cnvprb -h [header]
4: # -s [script]
5: # -t [footer]
6: # -i [import prefix]
7: # -f [file1] [file2] [file3] >[outputfile].problem
8: # -l [library references]
9: #
10: # Written by Robert McQueen and Mark Lucas, Ohio University
11: #------------------------------------------------------------------------------
12:
13: # create alias for pre-defined Perl variables used in subroutines
14:
15: *corrected_list = *inlist = *_;
16:
17: # parse command-line args
18:
19: @header = ();
20: @script = ();
21: @footer = ();
22: @files = ();
23: @lib_refs = ();
24: @import_prefix = ();
25:
26: &parse_ARGV();
27:
28: # insert problem header
29:
30: @output = "<problem>";
31:
32: # run through each file
33:
34: foreach $file (@files) {
35:
36: open(INFILE,"$file") || die "$file does not exist!!\n";
37: @prfile = <INFILE>;
38: close(INFILE);
39:
40: # pre-filter problem
41:
42: @prfile = &pre_filter(@prfile);
43:
44: $temp_file = "/tmp/OUcnvprb.tmp";
45:
46: open(TMPFILE, ">$temp_file");
47: print TMPFILE @prfile;
48: close(TMPFILE);
49:
50: # convert to LON-CAPA format
51:
52: push (@output, `capaconverter $import_prefix -f $temp_file`);
53:
54: @output = &remove_final_part_tag(@output);
55: }
56:
57: # delete temporary file from system
58:
59: unlink("$temp_file");
60:
61: # insert problem footer
62:
63: @output = (@output, "</problem>");
64:
65: # filter the output
66:
67: %string_var; # list of string variables encountered in file
68:
69: @output = &remove_problem_num(@output);
70: @output = &fix_refs(@output);
71: @output = &fix_lon_capa_tags(@output);
72: @output = &declare_responses(@output);
73: @output = &fix_response_params(@output);
74: # @output = &fix_hints(@output);
75: @output = &format_html_tags(@output);
76: @output = &fix_script_functs(@output);
77: # @output = &fix_outtext_functs(@output);
78: # @output = &exempt_tex_formatting(@output);
79: # @output = &supplement_tex_formatting(@output);
80: @output = &remove_empty_script_blocks(@output);
81: @output = &add_newlines(@output);
82: # @output = ÷_parts(@output);
83: @output = &remove_single_part_tags(@output);
84:
85: if (@header) { map s|(<problem>)|\1\n\n@header|, @output; }
86: if (@footer) { map s|(</problem>)|@footer\n\1|, @output; }
87: if (@script) { map eval "@script", @output; }
88:
89: # output conversion to STDOUT
90:
91: print @output;
92:
93: #------------------------------------------------------------------------------
94: # parse_ARGV: parses and interpolates command-line arguments
95: # ----------
96: # - headers = text to be output immediately following the <problem> tag
97: # - scripts = scripts to be run on the post-translated problem
98: # - footers = text to be output immediately before the </problem> tag
99: # - import prefix = domain prefix to be placed before resource references
100: # - files = files to be converted and translated
101: # - library references = supported libraries [see fix_refs subroutine]
102: #
103: # * Calls: "interpolate_string" subroutine
104: # -----
105: #------------------------------------------------------------------------------
106:
107: sub parse_ARGV {
108:
109: unless ($ARGV[0] =~ /^-/) {
110: die "usage: OUcnvprb [OPTION]... SOURCE... >[DEST].problem \n".
111: " OPTIONS include: \n".
112: " -h [headers] \n".
113: " -s [scripts] \n".
114: " -t [footers] \n".
115: " -i [import prefix] \n".
116: " -f [files] \n".
117: " -l [library references] \n".
118: " SOURCE can be any type of Perl string ".
119: "[file name, command, variable...] \n";
120: }
121:
122: foreach (@ARGV) {
123:
124: if (/^-.$/) {
125:
126: if (/h/) { *argv = *header; }
127: elsif (/s/) { *argv = *script; }
128: elsif (/t/) { *argv = *footer; }
129: elsif (/f/) { *argv = *files; }
130: elsif (/i/) { *argv = *import_prefix;
131: # push(@argv, $_);
132: }
133: elsif (/l/) { *argv = *lib_refs; }
134: else { die "$_ option does not exist\n"; }
135:
136: } else {
137:
138: push(@argv, $_);
139: }
140: }
141:
142:
143: map s|$_|interpolate_string($_)|e, @header;
144: map s|$_|interpolate_string($_)|e, @script;
145: map s|$_|interpolate_string($_)|e, @footer;
146: map s|$_|interpolate_string($_)|e, @lib_refs;
147:
148: $import_prefix = $import_prefix[0-1];
149: }
150:
151: #------------------------------------------------------------------------------
152: # interpolate_string: (helper function for "parse_ARGV" subroutine)
153: # ------------------
154: # - determines whether a string is a file or a literal
155: # - returns the true value of the string
156: #------------------------------------------------------------------------------
157:
158: sub interpolate_string {
159:
160: my $input = $_[0];
161:
162: if (-r $input) {
163:
164: open(INPUTFILE, $input);
165: $input = "";
166: while (<INPUTFILE>) {$input .= $_;}
167: close(INPUTFILE);
168: }
169:
170: return "$input";
171: }
172:
173: #------------------------------------------------------------------------------
174: # pre_filter: handles special pre-filtering tasks
175: # ----------
176: # - removes /DIS("") which would otherwise output arbitrary ''
177: # - removes /DIS(stdline) which will be reinserted in the
178: # appropriate place later
179: # - removes all references to the problem() function call
180: # which is not supported in LON-CAPA along with the
181: # associated formatting statements
182: # - replaces backquotes with single quotes
183: # - escapes all single quotes to avoid later confusion
184: # - special substitution for tipler image inclusion
185: #------------------------------------------------------------------------------
186:
187: sub pre_filter {
188:
189: map {
190:
191: s|/?/DIS\(""\)||g;
192: s|/DIS\(stdline\)||g;
193: s|//DIS|\#DIS|g;
194: s|(?:/DIS\(tex\("[^"]*?","[^"]*?"\)\))?/DIS\(problem\(\)\)[\.]?(?:/DIS\(tex\("[^"]*?","[^"]*?"\)\))?[\.]?||g;
195: s|\#DIS|//DIS|g;
196: tr|`|'|;
197:
198: s|/DIS\("http://"\+machine_name\+webfigs_dir\+"(.*?)"\)|"/tipler/Graphics$1"|g;
199: s|"\+psfigs_dir\+"|/tipler/Graphics|g;
200:
201: # temporary fix for mult. choice prbs
202: s|(tex\("[\\]{2}",")("\))|\1<br />\2|g;
203:
204: } @inlist;
205:
206: return @corrected_list;
207: }
208:
209: #------------------------------------------------------------------------------
210: # remove_final_part_tag: removes the final <part> placed by the converter
211: # ---------------------
212: #
213: # - assumes the final <part> is not matched by a closing </part>
214: #------------------------------------------------------------------------------
215:
216: sub remove_final_part_tag {
217:
218: map {
219:
220: return @corrected_list if (s|<part>||);
221:
222: } reverse @inlist;
223: }
224:
225: #------------------------------------------------------------------------------
226: # remove_problem_num: removes the Problem# <import> statement
227: # ------------------
228: # - Problem# import utility not supported in LON-CAPA -> delete!
229: #------------------------------------------------------------------------------
230:
231: sub remove_problem_num {
232:
233: map {
234:
235: s|<import>.*?Problem#.*?</import>||gi;
236:
237: } @inlist;
238:
239: return @corrected_list;
240: }
241:
242: #------------------------------------------------------------------------------
243: # fix_refs: corrects all references to particular problem libraries
244: # --------
245: # - adds .library file extension to all MCTools file references
246: # - removes hyphen from references to the new serway-lib
247: # due to system complications caused by using the hyphen
248: # - adds domain prefix before all resource references
249: #------------------------------------------------------------------------------
250:
251: sub fix_refs {
252:
253: my $lib_refs = $_ = join(" ", @lib_refs);
254:
255: $lib_refs = join("|/", split);
256:
257: map {
258:
259: s|(/MCTools.*?)(</import>)|\1.library\2|g;
260: s|(serway)-(lib)|$1$2|g;
261:
262: if (@lib_refs) {
263:
264: s|(/$lib_refs)|$import_prefix$1|gi unless (m|<import>|);
265: }
266:
267: } @inlist;
268:
269: return @corrected_list;
270: }
271:
272: #------------------------------------------------------------------------------
273: # fix_lon_capa_tags: modifies various LON-CAPA tags
274: # -----------------
275: # - adds newlines to script tags
276: # - places a <hr /> after <startouttext /> tags
277: # - places a <br /> before <endouttext /> tags
278: #
279: # * Calls: "split_lines" subroutine
280: # -----
281: #------------------------------------------------------------------------------
282:
283: sub fix_lon_capa_tags {
284:
285: my $first = 0;
286:
287: map {
288:
289: $first = 0 if (m|<part>|);
290: $first = s|(<startouttext />)|\1<hr />|g unless ($first);
291: s|([\s]*?)(<endouttext />)|\1<br />\n\1\2|g;
292: s|(<script type="loncapa/perl">)|\1\n|g;
293: s|(</script>)|\n\1\n|g;
294:
295: } @inlist;
296:
297: @corrected_list = &split_lines(@corrected_list);
298:
299: return @corrected_list;
300: }
301:
302: #------------------------------------------------------------------------------
303: # declare_responses: parses LON-CAPA response types
304: # -----------------
305: # - declares string responses
306: #------------------------------------------------------------------------------
307:
308: sub declare_responses {
309:
310: my $string_opt;
311: my $stringresponse = 0;
312: my $scriptmode = 0;
313:
314: *is_string = *string_type = *string_var;
315:
316: map {
317:
318: $scriptmode = 1 if (m|<script type="loncapa/perl">|);
319: $scriptmode = 0 if (m|</script>|);
320:
321: if ($scriptmode) {
322:
323: if (m|(\$[\w]+?)=&choose\(\$[\w]+?[,'A-H]+?\)|gi) {
324:
325: $string_type{$1} = 'type="mc"';
326:
327: } elsif (m|(\$[\w]+?)=.*?['"]|gi) {
328:
329: $string_type{$1} = 'type="ci"';
330:
331: } elsif (m|(\$[\w]+?)=([^\-\*/]*?)\;|gi) {
332:
333: my $vars_to_check = $2;
334:
335: { $vars_to_check =~ s|\;|+|g;
336: $vars_to_check =~ s|&choose.*?,||g; }
337:
338: my @the_line = grep /\$[\w]+/, split (/[^\$\w]/, $vars_to_check);
339:
340: my $valid_string_line = 1;
341:
342: foreach $var (@the_line) {
343:
344: # test if other vars ecountered within the line were strings
345:
346: if ($valid_string_line) {
347:
348: if ($is_string{$var}) {
349:
350: $string_type{$1} = 'type="ci"';
351: $valid_string_line = 1;
352:
353: } else {
354:
355: delete $string_var{$1};
356: $valid_string_line = 0;
357: }
358: }
359: }
360: } elsif (m|(\$[\w]+?)=|gi) {
361:
362: delete $string_var{$1};
363: }
364: }
365:
366: if (m|<numericalresponse answer="([^"]*?)" .*?>|) {
367:
368: $string_opt = $string_type{$1};
369:
370: if ($string_opt) {
371:
372: $stringresponse = s|<numerical(response answer="[^"]*?")>|<string\1 $string_opt>|g;
373:
374: } else {
375:
376: $stringresponse = s|<numerical(response[^<>]*?type=".*?")|<string\1|g;
377: }
378: }
379:
380: if ($stringresponse) {
381:
382: $stringresponse = 0 if s|(</)numerical(response>)|\1string\2|g;
383: }
384:
385: } @inlist;
386:
387: return @corrected_list;
388: }
389:
390: #------------------------------------------------------------------------------
391: # olddeclare_responses: parses LON-CAPA response types
392: # --------------------
393: # - corrects response tags
394: # * uses last variable declaration before response tag to determine
395: # response type
396: # * assumes: 1) string variable is assigned to a bare string
397: # [not in a function call]
398: # 2) multiple choice response variables are declared as
399: # $CAPA4ANS [may be OU-specific]
400: # * only handles numerical and string response types
401: #------------------------------------------------------------------------------
402:
403: sub olddeclare_responses {
404:
405: my $string_ans = 0;
406: my $string_opt = '';
407: my $stringresponse = 0;
408:
409: map {
410:
411: s|<numerical(response[^<>]*?type=".*?")|<string\1|g;
412:
413: if (m|\$CAPA4ANS=&choose\(\$[\w]+?[,'A-H]+?\)|gi) {
414: $string_ans = 1;
415: $string_opt = 'mc';
416: } elsif (m|\$[\w]+?=['"]|gi) {
417: $string_ans = 1;
418: $string_opt = 'ci';
419: } elsif (m|\$[\w]+?=.|gi) {
420: $string_ans = 0;
421: }
422:
423: if (m|<numericalresponse answer="[^"]*?">|) {
424: if ($string_ans) {
425: s|<numerical(response answer="[^"]*?")>|<string\1 type="$string_opt">|g;
426: }
427: $stringresponse = $string_ans;
428: } elsif (m|<numericalresponse.*?format[^>]*?>|) {
429: $stringresponse = 0;
430: }
431:
432: if ($stringresponse) {
433: s|(</)numerical(response>)|\1string\2|g;
434: }
435:
436: } @inlist;
437:
438: return @corrected_list;
439: }
440:
441: #------------------------------------------------------------------------------
442: # sub fix_response_params: parses LON-CAPA response types
443: # -----------------------
444: # - replaces old usage of +/- for "Significant Figures" default
445: # responseparam arguments with new , format
446: #------------------------------------------------------------------------------
447:
448: sub fix_response_params {
449:
450: my $base;
451: my @plus, @minus;
452: my $lower, $upper;
453:
454: map {
455:
456: if (m|<responseparam name="sig"|) {
457:
458: if (m|default="([\d]+)([\+\-][\d]+)([\+\-][\d]+)*?"|) {
459:
460: $base = $1;
461: @plus = grep /\+/, $2, $3;
462: @minus = grep /\-/, $2, $3;
463:
464: $lower = eval "$base $minus[0]";
465: $upper = eval "$base $plus[0]";
466:
467: s|(default=)".*?"|\1"$lower,$upper"|gi;
468: }
469: }
470:
471: } @inlist;
472:
473: return @corrected_list;
474: }
475:
476: #------------------------------------------------------------------------------
477: # format_html_tags: makes html appear like standard xml
478: # ----------------
479: # - places quotes around tag-arguments
480: # - makes html tags lowercase
481: # - adds closing / to single-tag commands
482: # - places <p /> around images -> enhances display of images
483: #------------------------------------------------------------------------------
484:
485: sub format_html_tags {
486:
487: map {
488:
489: if (/<[^<>]*?=[^<>]*?>/) {
490: s#(.*?={1}(?:[\s]?)*)([^\s<>'"]+?)([\s]|[/]?>)#\1"\2"\3#g;
491: }
492:
493: s|<br>|<br />|gi;
494: # s|(<img src.*?>)<br />|\1|gi;
495: # s|<IMG SRC(.*?)>|<p /><img src\1 /><p />|gi;
496: # s|(<img src.*?>)<p /><p />(<img src.*?>)|\1\2|gi;
497: s|<A HREF(.*?)>|<a href\1>|gi;
498: s|</A>|</a>|gi;
499: s|<P>|<p>|gi;
500: s|</P>|</p>|gi;
501:
502: } @inlist;
503:
504: return @corrected_list;
505: }
506:
507: #------------------------------------------------------------------------------
508: # replace_old_functs: reformats seemingly obsolete uses of functions
509: # ------------------
510: # - &tex(1,2) calls -> <m>1</m> makes more xml-ish
511: # - &var_in_tex(1) calls -> <tex>1</tex> makes more xml-ish
512: # - if no formatting is involved, removes &to_string() call
513: # * neither LON-CAPA nor Perl discerns between specific scalar types
514: # - &html(*) -> <web>*</web> makes more xml-ish
515: # - combines consecutive <web> statements into one <web>*</web>
516: # - flags images within &web() calls for later handling
517: # - all other &web(1,2,3) calls -> <m>2</m>
518: #------------------------------------------------------------------------------
519:
520: sub replace_old_functs {
521:
522: # map {
523:
524: s|&tex\('(.*?)','(?:.*?)'\)|<m>\1</m>|g;
525: s|&var_in_tex\((.*?)\)|<tex>\1</tex>|g;
526: s|&to_string\(([^,]*?)\)|\1|g;
527: s|&html\('?(.*?)'?\)|<web>\1</web>|g;
528: s|([^<]*?)</web>[\s]*?<web>(.*?)|\1\2|g;
529: s|&web(\('(?:.*)','(?:.*)','.*?<img.*'\))|&WEBFIG\1|gi;
530: s|&web\('(?:.*?)','(.*?)','(?:.*?)'\)|<m>\1</m>|g;
531:
532: # } @inlist;
533:
534: # return @corrected_list;
535: }
536:
537: #------------------------------------------------------------------------------
538: # fix_script_functs: formats function calls that appear within script blocks
539: # -----------------
540: # - removes blank comment lines
541: # - combines consecutive <m> statements into one <m>*</m>
542: # * also combines consecutive math modes
543: # - places xml tags within &xmlparse() calls
544: # * also if needed, places a ; after call
545: # - maintains images within &web(1,2,3) calls
546: # - handles string concatenation
547: # - if &xmlparse() calls are unassigned
548: # -> &xmlparse(*) -> *
549: # -> move this to next outtext area
550: # -> if no more exist, then simply move outside of script block
551: #------------------------------------------------------------------------------
552:
553: sub fix_script_functs {
554:
555: my @outlist = ();
556: my $scriptmode = 0;
557:
558: map {
559:
560: $scriptmode = 1 if (m|<script type="loncapa/perl">|);
561: $scriptmode = 0 if (m|</script>|);
562:
563: if ($scriptmode) {
564:
565: # $_ =~ &replace_old_functs;
566: s|^#[\s]*$||g;
567: s|(.*?)</m>[\s\+]*?<m>(.*?)|\1\2|g;
568: s|\$\$||g;
569: s#(<(?:m|web|tex)>.*?</(?:m|web|tex)>)#&xmlparse('\1')#g;
570: s|(&xmlparse\('.*?'\))([^;,)\.\+\-\*\/])|\1;\2|g;
571: s|&WEBFIG|&web|g;
572:
573: # handle string concatenation
574:
575: &concatenate_strings($_);
576: }
577:
578: } @inlist;
579:
580: return @corrected_list;
581: }
582:
583: #------------------------------------------------------------------------------
584: # concatenate_strings: (helper function for "fix_script_functs" subroutine)
585: # ------------------- handles string concatenation
586: #
587: # * replaces a + with a . when it appears:
588: # - between an unescaped quote and a quoted string
589: # as well as between a function call that has a quoted argument
590: # and a quoted string
591: # - before a function call that has a quoted argument
592: # - between two quoted strings and/or a quoted string and a scalar
593: # string variable
594: #------------------------------------------------------------------------------
595:
596: sub concatenate_strings {
597:
598: s|[\+]([\s]*?)(\$[\w]+)|if ($is_string{$2}){".$1$2"} else {"+$1$2"}|ge;
599: s|(\$[\w]+)([\s]*?)[\+]|if ($is_string{$1}){"$1$2."} else {"$1$2+"}|ge;
600: s|([^\\]['][)]?[\s]*?)\+([\s]*?['][^,);.])|\1.\2|g;
601: s|\+([\s]*?&[\w]+?\(')|.\1|g;
602: }
603:
604: #------------------------------------------------------------------------------
605: # fix_outtext_functs: formats function calls that appear within outtext
606: # ------------------ blocks
607: #
608: # - converts images within &web(1,2,3) calls into
609: # <tex>1</tex><web>2</web>
610: # - combines consecutive <m> statements into one <m>*</m>
611: # * also combines consecutive math modes
612: # - places <display> tags around &choose() calls
613: # - removes \ from single quotes escaped during pre-processing
614: #------------------------------------------------------------------------------
615:
616: sub fix_outtext_functs {
617:
618: my $textmode = 0;
619:
620: map {
621:
622: $textmode = 1 if (m|<startouttext />|);
623: $textmode = 0 if (m|<endouttext />|);
624:
625: if ($textmode) {
626: $_ =~ &replace_old_functs();
627: s|(.*?)</m>[\s]*?<m>(.*?)|\1\2|g;
628: s|(<m>.*?)\$[\s]*?\$(.*?</m>)|\1\2|g;
629: s|&WEBFIG\('(?:.*)','(.*)','(.*?<img.*)'\)|<tex>\1</tex><web>\2</web>|gi;
630: s|(&choose\([^&]*?\))|<display>\1</display>|g;
631: s|[\\](['])|\1|g;
632: }
633:
634: } @inlist;
635:
636: return @corrected_list;
637: }
638:
639: #------------------------------------------------------------------------------
640: # exempt_tex_formatting: parses <m> statements for tex-only output
641: # --------------------
642: # - places tex figures and formatting commands within <tex> tags
643: # - accounts for unmatched closing braces caused by the above action
644: # which would otherwise cause display problems for LON-CAPA
645: #
646: # * Special Note: This function was created in response to
647: # ------------ difficulties experienced with using <m>
648: #------------------------------------------------------------------------------
649:
650: sub exempt_tex_formatting {
651:
652: map {
653:
654: s|<m>([^<]*?epsf[^<]*?)</m>|<tex>\1</tex>|gi;
655: s|<m>([^<]*?\.[e]?ps[^<]*?)</m>|<tex>\1</tex>|gi;
656: s#<m>([^<]*?(?:skip|indent|space)[^<]*?)</m>#<tex>\1</tex>#gi;
657: s#<m>([^<]*?(?:box|quote|put)[^<]*?)</m>#<tex>\1</tex>#gi;
658: s#<m>([\s]*?[}][\s]*?)</m>#<tex>\1</tex>#gi;
659:
660: } @inlist;
661:
662: return @corrected_list;
663: }
664:
665: #------------------------------------------------------------------------------
666: # supplement_tex_formatting: supplements basic tex formatting with
667: # ------------------------- corresponding web formatting
668: #
669: # - tex \\ -> <tex>\\</tex><web><br /></web>
670: # - tex *box -> <tex>*box*</tex><web><p /></web>
671: #
672: # * Special Note: This function was created in response to
673: # ------------ difficulties experienced with using <m>
674: #------------------------------------------------------------------------------
675:
676: sub supplement_tex_formatting {
677:
678: map {
679:
680: s|<m>(\\\\)</m>|<tex>\1</tex><web><br /></web>|g;
681: s|(<tex>[^<]*?box[^<]*?</tex>)|\1<web><p /></web>|g;
682:
683: } @inlist;
684:
685: return @corrected_list;
686: }
687:
688: #------------------------------------------------------------------------------
689: # fix_hints: handles placement and formatting of hintgroups
690: # ---------
691: # - removes <hr /> after hint <startouttext /> tag
692: # - places a tab before each hintgroup line
693: # - places hintgroup into an array
694: # - immediately outputs hintgroup within next <*response> tag
695: # * outputs immediately after <textline />
696: #------------------------------------------------------------------------------
697:
698: sub fix_hints {
699:
700: my @outlist = ();
701: my $hintmode = 0;
702: my $pasthintmode = 0;
703: my $responsemode = 0;
704: my $pastresponsemode = 0;
705: my $inlist_index = 0;
706: my @hint_group = ();
707:
708: map {
709:
710: if (m|<hintgroup>|) {
711: $hintmode = 1;
712: } elsif (m|</hintgroup>|) {
713: $hintmode = 0;
714: } elsif (m|<textline />|) {
715: $responsemode = 1;
716: } elsif (m|</[\w]*?response>|) {
717: $responsemode = 0;
718: }
719:
720: if ($hintmode || $pasthintmode) {
721: s|(<startouttext />)<hr />|\1|g;
722: push(@hint_group,"\t$_");
723: $_ = "";
724:
725: } elsif (!$pasthintmode && @hint_group) {
726:
727: my $num_repsonse_blocks = 0;
728: my @inlistcpy = @inlist;
729:
730: for ($cpyindex = 0; $cpyindex < $inlist_index; $cpyindex++) {
731: shift(@inlistcpy);
732: }
733:
734: foreach (@inlistcpy) {
735: if (m|<textline />|) {
736: $num_repsonse_blocks++;
737: }
738: }
739:
740: if (!$responsemode && $pastresponsemode || !$num_repsonse_blocks) {
741: push(@outlist,@hint_group);
742: @hint_group = ();
743: }
744: }
745: push(@outlist,$_);
746:
747: $pasthintmode = $hintmode;
748: $pastresponsemode = $responsemode;
749: $inlist_index++;
750:
751: } @inlist;
752:
753: return @outlist; #return corrected list
754: }
755:
756: #------------------------------------------------------------------------------
757: # divide_parts: separates a problem into parts based on number of
758: # ------------ response blocks
759: #
760: # - counts number of <*reponse> blocks
761: # - if there is more than one response block, divides the problem
762: # into its respective parts
763: # - adds trailing $stdline
764: #
765: # * Calls: "insert_part_tags" subroutine
766: # ----- "insert_stdline" subroutine
767: #------------------------------------------------------------------------------
768:
769: sub divide_parts {
770:
771: my $parts = 0;
772:
773: $parts = map m|</[\w]+?response>|, @inlist;
774:
775: if ($parts > 1) {
776:
777: @corrected_list = &insert_part_tags(@inlist, $parts);
778: }
779:
780: # @corrected_list = &insert_stdline(@corrected_list, $parts);
781:
782: return @corrected_list;
783: }
784:
785: #------------------------------------------------------------------------------
786: # insert_part_tags: (helper function for "divide_parts" subroutine)
787: # ---------------- inserts respective <part> tags into problem file
788: #
789: # - places the first <part> after <problem>
790: # - places intermittent </part> and <part> after each response
791: # - corrects above procedure for the final response
792: #------------------------------------------------------------------------------
793:
794: sub insert_part_tags {
795:
796: my $num_parts = pop(@_);
797: my $part = 1;
798:
799: map {
800:
801: if ($part <= $num_parts) {
802:
803: s|(<problem>)|\1\n\n<part>|g;
804:
805: if (m|</[\w]+?response>|) {
806:
807: s|(</[\w]+?response>)|\1\n</part>\n\n<part>|g;
808:
809: if ($part++ == $num_parts) {
810:
811: s|(</[\w]+?response>)\n</part>\n\n<part>|\1|g;
812: }
813: }
814:
815: } # only used for efficiency purposes
816:
817: s|(</problem>)|</part>\n\1|g;
818:
819: } @inlist;
820:
821: return @corrected_list;
822: }
823:
824: #------------------------------------------------------------------------------
825: # remove_single_part_tags: corrects one-part problem syntax
826: # -----------------------
827: #
828: # - removes the part tags the converter places around one-part problems
829: #------------------------------------------------------------------------------
830:
831: sub remove_single_part_tags {
832:
833: my @num_parts = grep m|</part>|, @inlist;
834:
835: map s|</?part>||g, @inlist unless ($#num_parts);
836:
837: return @corrected_list;
838: }
839:
840: #------------------------------------------------------------------------------
841: # insert_stdline: (helper function for "divide_parts" subroutine)
842: # -------------- inserts trailing $stdline
843: #
844: # - for multipart problems, inserts the $stdline before </problem>
845: # - otherwise, inserts it after </problem>
846: # [placement of $stdline is purely aesthetic]
847: #------------------------------------------------------------------------------
848:
849: sub insert_stdline {
850:
851: my $num_parts = pop(@_);
852:
853: my $stdline = "\n<startouttext />\n\$stdline\n<br />\n<endouttext />";
854:
855: if ($num_parts > 1) {
856: $stdline = "\n</problem>\n" . $stdline;
857: } else {
858: $stdline .= "\n\n</problem>";
859: }
860:
861: map s|</problem>|$stdline|g, @inlist;
862:
863: return @corrected_list;
864: }
865:
866: #------------------------------------------------------------------------------
867: # remove_empty_script_blocks: removes <script> blocks emptied during
868: # -------------------------- prior processing
869: #
870: # * Calls: "split_lines" subroutine
871: # -----
872: #------------------------------------------------------------------------------
873:
874: sub remove_empty_script_blocks {
875:
876: my $nextline = 0;
877:
878: @inlist = &split_lines(@inlist);
879:
880: map {
881:
882: ++$nextline;
883:
884: if (m|<script type="loncapa/perl">|) {
885:
886: if ($inlist[$nextline] =~ s|</script>||) {
887:
888: s|<script type="loncapa/perl">||;
889: }
890: }
891:
892: } @inlist;
893:
894: return @corrected_list;
895: }
896:
897: #------------------------------------------------------------------------------
898: # add_newlines: strategically places additional newline before various
899: # ------------ sections of code
900: #
901: # * Calls: "split_lines" subroutine
902: # -----
903: #------------------------------------------------------------------------------
904:
905: sub add_newlines {
906:
907: @inlist = &split_lines(@inlist);
908:
909: map {
910:
911: s|([\s]*<import>)|\n\1|g;
912: s|([\s]*<script type="loncapa/perl">)|\n\1|g;
913: s|([\s]*<startouttext /><hr />)|\n\1|g;
914: s|([\s]*<block.*?>)|\n\1|g;
915: s|([\s]*<[\w]+?response[\s>])|\n\1|g;
916:
917: } @inlist;
918:
919: return @corrected_list;
920: }
921:
922: #------------------------------------------------------------------------------
923: # split_lines: (helper function for general use)
924: # ----------- returns an array with each element representing a separate
925: # line of code that existed in the input array
926: #
927: # - splits input array based on \n
928: # * each element of the new array represents a different line of
929: # the problem file
930: # * alleviates problem of detecting \n's within strings
931: # * all \n's are lost during this operation
932: # - adds '\n' to the end of each line in new array
933: #------------------------------------------------------------------------------
934:
935: sub split_lines {
936:
937: @inlist = map split(/\n/), @inlist;
938:
939: @corrected_list = map "$_\n", @inlist;
940:
941: return @corrected_list;
942: }
943:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>