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 = &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: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>