Annotation of loncom/homework/CAPA-converter/conversion_wrapper/cnvprb, revision 1.1
1.1 ! albertel 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>