loncom/homework/CAPA-converter/conversion_wrapper/cnvprb - view

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, 2 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_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 = &divide_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: