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, 9 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_6,
version_2_11_5_msu,
version_2_11_5,
version_2_11_4_uiuc,
version_2_11_4_msu,
version_2_11_4,
version_2_11_3_uiuc,
version_2_11_3_msu,
version_2_11_3,
version_2_11_2_uiuc,
version_2_11_2_msu,
version_2_11_2_educog,
version_2_11_2,
version_2_11_1,
version_2_11_0_RC3,
version_2_11_0_RC2,
version_2_11_0_RC1,
version_2_11_0,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
version_2_0_X,
version_2_0_99_1,
version_2_0_2,
version_2_0_1,
version_2_0_0,
version_1_99_3,
version_1_99_2,
version_1_99_1_tmcc,
version_1_99_1,
version_1_99_0_tmcc,
version_1_99_0,
version_1_3_X,
version_1_3_3,
version_1_3_2,
version_1_3_1,
version_1_3_0,
version_1_2_X,
version_1_2_99_1,
version_1_2_99_0,
version_1_2_1,
version_1_2_0,
version_1_1_X,
version_1_1_99_5,
version_1_1_99_4,
version_1_1_99_3,
version_1_1_99_2,
version_1_1_99_1,
version_1_1_99_0,
version_1_1_3,
version_1_1_2,
version_1_1_1,
version_1_1_0,
version_1_0_99_3,
version_1_0_99_2,
version_1_0_99_1,
version_1_0_99,
version_1_0_3,
version_1_0_2,
version_1_0_1,
version_1_0_0,
version_0_99_5,
version_0_99_4,
version_0_99_3,
version_0_99_2,
version_0_99_1,
version_0_99_0,
version_0_6_2,
version_0_6,
version_0_5_1,
version_0_5,
loncapaMITrelate_1,
language_hyphenation_merge,
language_hyphenation,
conference_2003,
bz6209-base,
bz6209,
bz5969,
bz2851,
PRINT_INCOMPLETE_base,
PRINT_INCOMPLETE,
HEAD,
GCI_3,
GCI_2,
GCI_1,
BZ5971-printing-apage,
BZ5434-fox,
BZ4492-merge,
BZ4492-feature_horizontal_radioresponse,
BZ4492-feature_Support_horizontal_radioresponse,
BZ4492-Support_horizontal_radioresponse
- adding Ohio Universities CAPA -> LON-CAPA cleanup scripts
#!/usr/bin/perl
#
# cnvprb -h [header]
# -s [script]
# -t [footer]
# -i [import prefix]
# -f [file1] [file2] [file3] >[outputfile].problem
# -l [library references]
#
# Written by Robert McQueen and Mark Lucas, Ohio University
#------------------------------------------------------------------------------
# create alias for pre-defined Perl variables used in subroutines
*corrected_list = *inlist = *_;
# parse command-line args
@header = ();
@script = ();
@footer = ();
@files = ();
@lib_refs = ();
@import_prefix = ();
&parse_ARGV();
# insert problem header
@output = "<problem>";
# run through each file
foreach $file (@files) {
open(INFILE,"$file") || die "$file does not exist!!\n";
@prfile = <INFILE>;
close(INFILE);
# pre-filter problem
@prfile = &pre_filter(@prfile);
$temp_file = "/tmp/OUcnvprb.tmp";
open(TMPFILE, ">$temp_file");
print TMPFILE @prfile;
close(TMPFILE);
# convert to LON-CAPA format
push (@output, `capaconverter $import_prefix -f $temp_file`);
@output = &remove_final_part_tag(@output);
}
# delete temporary file from system
unlink("$temp_file");
# insert problem footer
@output = (@output, "</problem>");
# filter the output
%string_var; # list of string variables encountered in file
@output = &remove_problem_num(@output);
@output = &fix_refs(@output);
@output = &fix_lon_capa_tags(@output);
@output = &declare_responses(@output);
@output = &fix_response_params(@output);
# @output = &fix_hints(@output);
@output = &format_html_tags(@output);
@output = &fix_script_functs(@output);
# @output = &fix_outtext_functs(@output);
# @output = &exempt_tex_formatting(@output);
# @output = &supplement_tex_formatting(@output);
@output = &remove_empty_script_blocks(@output);
@output = &add_newlines(@output);
# @output = ÷_parts(@output);
@output = &remove_single_part_tags(@output);
if (@header) { map s|(<problem>)|\1\n\n@header|, @output; }
if (@footer) { map s|(</problem>)|@footer\n\1|, @output; }
if (@script) { map eval "@script", @output; }
# output conversion to STDOUT
print @output;
#------------------------------------------------------------------------------
# parse_ARGV: parses and interpolates command-line arguments
# ----------
# - headers = text to be output immediately following the <problem> tag
# - scripts = scripts to be run on the post-translated problem
# - footers = text to be output immediately before the </problem> tag
# - import prefix = domain prefix to be placed before resource references
# - files = files to be converted and translated
# - library references = supported libraries [see fix_refs subroutine]
#
# * Calls: "interpolate_string" subroutine
# -----
#------------------------------------------------------------------------------
sub parse_ARGV {
unless ($ARGV[0] =~ /^-/) {
die "usage: OUcnvprb [OPTION]... SOURCE... >[DEST].problem \n".
" OPTIONS include: \n".
" -h [headers] \n".
" -s [scripts] \n".
" -t [footers] \n".
" -i [import prefix] \n".
" -f [files] \n".
" -l [library references] \n".
" SOURCE can be any type of Perl string ".
"[file name, command, variable...] \n";
}
foreach (@ARGV) {
if (/^-.$/) {
if (/h/) { *argv = *header; }
elsif (/s/) { *argv = *script; }
elsif (/t/) { *argv = *footer; }
elsif (/f/) { *argv = *files; }
elsif (/i/) { *argv = *import_prefix;
# push(@argv, $_);
}
elsif (/l/) { *argv = *lib_refs; }
else { die "$_ option does not exist\n"; }
} else {
push(@argv, $_);
}
}
map s|$_|interpolate_string($_)|e, @header;
map s|$_|interpolate_string($_)|e, @script;
map s|$_|interpolate_string($_)|e, @footer;
map s|$_|interpolate_string($_)|e, @lib_refs;
$import_prefix = $import_prefix[0-1];
}
#------------------------------------------------------------------------------
# interpolate_string: (helper function for "parse_ARGV" subroutine)
# ------------------
# - determines whether a string is a file or a literal
# - returns the true value of the string
#------------------------------------------------------------------------------
sub interpolate_string {
my $input = $_[0];
if (-r $input) {
open(INPUTFILE, $input);
$input = "";
while (<INPUTFILE>) {$input .= $_;}
close(INPUTFILE);
}
return "$input";
}
#------------------------------------------------------------------------------
# pre_filter: handles special pre-filtering tasks
# ----------
# - removes /DIS("") which would otherwise output arbitrary ''
# - removes /DIS(stdline) which will be reinserted in the
# appropriate place later
# - removes all references to the problem() function call
# which is not supported in LON-CAPA along with the
# associated formatting statements
# - replaces backquotes with single quotes
# - escapes all single quotes to avoid later confusion
# - special substitution for tipler image inclusion
#------------------------------------------------------------------------------
sub pre_filter {
map {
s|/?/DIS\(""\)||g;
s|/DIS\(stdline\)||g;
s|//DIS|\#DIS|g;
s|(?:/DIS\(tex\("[^"]*?","[^"]*?"\)\))?/DIS\(problem\(\)\)[\.]?(?:/DIS\(tex\("[^"]*?","[^"]*?"\)\))?[\.]?||g;
s|\#DIS|//DIS|g;
tr|`|'|;
s|/DIS\("http://"\+machine_name\+webfigs_dir\+"(.*?)"\)|"/tipler/Graphics$1"|g;
s|"\+psfigs_dir\+"|/tipler/Graphics|g;
# temporary fix for mult. choice prbs
s|(tex\("[\\]{2}",")("\))|\1<br />\2|g;
} @inlist;
return @corrected_list;
}
#------------------------------------------------------------------------------
# remove_final_part_tag: removes the final <part> placed by the converter
# ---------------------
#
# - assumes the final <part> is not matched by a closing </part>
#------------------------------------------------------------------------------
sub remove_final_part_tag {
map {
return @corrected_list if (s|<part>||);
} reverse @inlist;
}
#------------------------------------------------------------------------------
# remove_problem_num: removes the Problem# <import> statement
# ------------------
# - Problem# import utility not supported in LON-CAPA -> delete!
#------------------------------------------------------------------------------
sub remove_problem_num {
map {
s|<import>.*?Problem#.*?</import>||gi;
} @inlist;
return @corrected_list;
}
#------------------------------------------------------------------------------
# fix_refs: corrects all references to particular problem libraries
# --------
# - adds .library file extension to all MCTools file references
# - removes hyphen from references to the new serway-lib
# due to system complications caused by using the hyphen
# - adds domain prefix before all resource references
#------------------------------------------------------------------------------
sub fix_refs {
my $lib_refs = $_ = join(" ", @lib_refs);
$lib_refs = join("|/", split);
map {
s|(/MCTools.*?)(</import>)|\1.library\2|g;
s|(serway)-(lib)|$1$2|g;
if (@lib_refs) {
s|(/$lib_refs)|$import_prefix$1|gi unless (m|<import>|);
}
} @inlist;
return @corrected_list;
}
#------------------------------------------------------------------------------
# fix_lon_capa_tags: modifies various LON-CAPA tags
# -----------------
# - adds newlines to script tags
# - places a <hr /> after <startouttext /> tags
# - places a <br /> before <endouttext /> tags
#
# * Calls: "split_lines" subroutine
# -----
#------------------------------------------------------------------------------
sub fix_lon_capa_tags {
my $first = 0;
map {
$first = 0 if (m|<part>|);
$first = s|(<startouttext />)|\1<hr />|g unless ($first);
s|([\s]*?)(<endouttext />)|\1<br />\n\1\2|g;
s|(<script type="loncapa/perl">)|\1\n|g;
s|(</script>)|\n\1\n|g;
} @inlist;
@corrected_list = &split_lines(@corrected_list);
return @corrected_list;
}
#------------------------------------------------------------------------------
# declare_responses: parses LON-CAPA response types
# -----------------
# - declares string responses
#------------------------------------------------------------------------------
sub declare_responses {
my $string_opt;
my $stringresponse = 0;
my $scriptmode = 0;
*is_string = *string_type = *string_var;
map {
$scriptmode = 1 if (m|<script type="loncapa/perl">|);
$scriptmode = 0 if (m|</script>|);
if ($scriptmode) {
if (m|(\$[\w]+?)=&choose\(\$[\w]+?[,'A-H]+?\)|gi) {
$string_type{$1} = 'type="mc"';
} elsif (m|(\$[\w]+?)=.*?['"]|gi) {
$string_type{$1} = 'type="ci"';
} elsif (m|(\$[\w]+?)=([^\-\*/]*?)\;|gi) {
my $vars_to_check = $2;
{ $vars_to_check =~ s|\;|+|g;
$vars_to_check =~ s|&choose.*?,||g; }
my @the_line = grep /\$[\w]+/, split (/[^\$\w]/, $vars_to_check);
my $valid_string_line = 1;
foreach $var (@the_line) {
# test if other vars ecountered within the line were strings
if ($valid_string_line) {
if ($is_string{$var}) {
$string_type{$1} = 'type="ci"';
$valid_string_line = 1;
} else {
delete $string_var{$1};
$valid_string_line = 0;
}
}
}
} elsif (m|(\$[\w]+?)=|gi) {
delete $string_var{$1};
}
}
if (m|<numericalresponse answer="([^"]*?)" .*?>|) {
$string_opt = $string_type{$1};
if ($string_opt) {
$stringresponse = s|<numerical(response answer="[^"]*?")>|<string\1 $string_opt>|g;
} else {
$stringresponse = s|<numerical(response[^<>]*?type=".*?")|<string\1|g;
}
}
if ($stringresponse) {
$stringresponse = 0 if s|(</)numerical(response>)|\1string\2|g;
}
} @inlist;
return @corrected_list;
}
#------------------------------------------------------------------------------
# olddeclare_responses: parses LON-CAPA response types
# --------------------
# - corrects response tags
# * uses last variable declaration before response tag to determine
# response type
# * assumes: 1) string variable is assigned to a bare string
# [not in a function call]
# 2) multiple choice response variables are declared as
# $CAPA4ANS [may be OU-specific]
# * only handles numerical and string response types
#------------------------------------------------------------------------------
sub olddeclare_responses {
my $string_ans = 0;
my $string_opt = '';
my $stringresponse = 0;
map {
s|<numerical(response[^<>]*?type=".*?")|<string\1|g;
if (m|\$CAPA4ANS=&choose\(\$[\w]+?[,'A-H]+?\)|gi) {
$string_ans = 1;
$string_opt = 'mc';
} elsif (m|\$[\w]+?=['"]|gi) {
$string_ans = 1;
$string_opt = 'ci';
} elsif (m|\$[\w]+?=.|gi) {
$string_ans = 0;
}
if (m|<numericalresponse answer="[^"]*?">|) {
if ($string_ans) {
s|<numerical(response answer="[^"]*?")>|<string\1 type="$string_opt">|g;
}
$stringresponse = $string_ans;
} elsif (m|<numericalresponse.*?format[^>]*?>|) {
$stringresponse = 0;
}
if ($stringresponse) {
s|(</)numerical(response>)|\1string\2|g;
}
} @inlist;
return @corrected_list;
}
#------------------------------------------------------------------------------
# sub fix_response_params: parses LON-CAPA response types
# -----------------------
# - replaces old usage of +/- for "Significant Figures" default
# responseparam arguments with new , format
#------------------------------------------------------------------------------
sub fix_response_params {
my $base;
my @plus, @minus;
my $lower, $upper;
map {
if (m|<responseparam name="sig"|) {
if (m|default="([\d]+)([\+\-][\d]+)([\+\-][\d]+)*?"|) {
$base = $1;
@plus = grep /\+/, $2, $3;
@minus = grep /\-/, $2, $3;
$lower = eval "$base $minus[0]";
$upper = eval "$base $plus[0]";
s|(default=)".*?"|\1"$lower,$upper"|gi;
}
}
} @inlist;
return @corrected_list;
}
#------------------------------------------------------------------------------
# format_html_tags: makes html appear like standard xml
# ----------------
# - places quotes around tag-arguments
# - makes html tags lowercase
# - adds closing / to single-tag commands
# - places <p /> around images -> enhances display of images
#------------------------------------------------------------------------------
sub format_html_tags {
map {
if (/<[^<>]*?=[^<>]*?>/) {
s#(.*?={1}(?:[\s]?)*)([^\s<>'"]+?)([\s]|[/]?>)#\1"\2"\3#g;
}
s|<br>|<br />|gi;
# s|(<img src.*?>)<br />|\1|gi;
# s|<IMG SRC(.*?)>|<p /><img src\1 /><p />|gi;
# s|(<img src.*?>)<p /><p />(<img src.*?>)|\1\2|gi;
s|<A HREF(.*?)>|<a href\1>|gi;
s|</A>|</a>|gi;
s|<P>|<p>|gi;
s|</P>|</p>|gi;
} @inlist;
return @corrected_list;
}
#------------------------------------------------------------------------------
# replace_old_functs: reformats seemingly obsolete uses of functions
# ------------------
# - &tex(1,2) calls -> <m>1</m> makes more xml-ish
# - &var_in_tex(1) calls -> <tex>1</tex> makes more xml-ish
# - if no formatting is involved, removes &to_string() call
# * neither LON-CAPA nor Perl discerns between specific scalar types
# - &html(*) -> <web>*</web> makes more xml-ish
# - combines consecutive <web> statements into one <web>*</web>
# - flags images within &web() calls for later handling
# - all other &web(1,2,3) calls -> <m>2</m>
#------------------------------------------------------------------------------
sub replace_old_functs {
# map {
s|&tex\('(.*?)','(?:.*?)'\)|<m>\1</m>|g;
s|&var_in_tex\((.*?)\)|<tex>\1</tex>|g;
s|&to_string\(([^,]*?)\)|\1|g;
s|&html\('?(.*?)'?\)|<web>\1</web>|g;
s|([^<]*?)</web>[\s]*?<web>(.*?)|\1\2|g;
s|&web(\('(?:.*)','(?:.*)','.*?<img.*'\))|&WEBFIG\1|gi;
s|&web\('(?:.*?)','(.*?)','(?:.*?)'\)|<m>\1</m>|g;
# } @inlist;
# return @corrected_list;
}
#------------------------------------------------------------------------------
# fix_script_functs: formats function calls that appear within script blocks
# -----------------
# - removes blank comment lines
# - combines consecutive <m> statements into one <m>*</m>
# * also combines consecutive math modes
# - places xml tags within &xmlparse() calls
# * also if needed, places a ; after call
# - maintains images within &web(1,2,3) calls
# - handles string concatenation
# - if &xmlparse() calls are unassigned
# -> &xmlparse(*) -> *
# -> move this to next outtext area
# -> if no more exist, then simply move outside of script block
#------------------------------------------------------------------------------
sub fix_script_functs {
my @outlist = ();
my $scriptmode = 0;
map {
$scriptmode = 1 if (m|<script type="loncapa/perl">|);
$scriptmode = 0 if (m|</script>|);
if ($scriptmode) {
# $_ =~ &replace_old_functs;
s|^#[\s]*$||g;
s|(.*?)</m>[\s\+]*?<m>(.*?)|\1\2|g;
s|\$\$||g;
s#(<(?:m|web|tex)>.*?</(?:m|web|tex)>)#&xmlparse('\1')#g;
s|(&xmlparse\('.*?'\))([^;,)\.\+\-\*\/])|\1;\2|g;
s|&WEBFIG|&web|g;
# handle string concatenation
&concatenate_strings($_);
}
} @inlist;
return @corrected_list;
}
#------------------------------------------------------------------------------
# concatenate_strings: (helper function for "fix_script_functs" subroutine)
# ------------------- handles string concatenation
#
# * replaces a + with a . when it appears:
# - between an unescaped quote and a quoted string
# as well as between a function call that has a quoted argument
# and a quoted string
# - before a function call that has a quoted argument
# - between two quoted strings and/or a quoted string and a scalar
# string variable
#------------------------------------------------------------------------------
sub concatenate_strings {
s|[\+]([\s]*?)(\$[\w]+)|if ($is_string{$2}){".$1$2"} else {"+$1$2"}|ge;
s|(\$[\w]+)([\s]*?)[\+]|if ($is_string{$1}){"$1$2."} else {"$1$2+"}|ge;
s|([^\\]['][)]?[\s]*?)\+([\s]*?['][^,);.])|\1.\2|g;
s|\+([\s]*?&[\w]+?\(')|.\1|g;
}
#------------------------------------------------------------------------------
# fix_outtext_functs: formats function calls that appear within outtext
# ------------------ blocks
#
# - converts images within &web(1,2,3) calls into
# <tex>1</tex><web>2</web>
# - combines consecutive <m> statements into one <m>*</m>
# * also combines consecutive math modes
# - places <display> tags around &choose() calls
# - removes \ from single quotes escaped during pre-processing
#------------------------------------------------------------------------------
sub fix_outtext_functs {
my $textmode = 0;
map {
$textmode = 1 if (m|<startouttext />|);
$textmode = 0 if (m|<endouttext />|);
if ($textmode) {
$_ =~ &replace_old_functs();
s|(.*?)</m>[\s]*?<m>(.*?)|\1\2|g;
s|(<m>.*?)\$[\s]*?\$(.*?</m>)|\1\2|g;
s|&WEBFIG\('(?:.*)','(.*)','(.*?<img.*)'\)|<tex>\1</tex><web>\2</web>|gi;
s|(&choose\([^&]*?\))|<display>\1</display>|g;
s|[\\](['])|\1|g;
}
} @inlist;
return @corrected_list;
}
#------------------------------------------------------------------------------
# exempt_tex_formatting: parses <m> statements for tex-only output
# --------------------
# - places tex figures and formatting commands within <tex> tags
# - accounts for unmatched closing braces caused by the above action
# which would otherwise cause display problems for LON-CAPA
#
# * Special Note: This function was created in response to
# ------------ difficulties experienced with using <m>
#------------------------------------------------------------------------------
sub exempt_tex_formatting {
map {
s|<m>([^<]*?epsf[^<]*?)</m>|<tex>\1</tex>|gi;
s|<m>([^<]*?\.[e]?ps[^<]*?)</m>|<tex>\1</tex>|gi;
s#<m>([^<]*?(?:skip|indent|space)[^<]*?)</m>#<tex>\1</tex>#gi;
s#<m>([^<]*?(?:box|quote|put)[^<]*?)</m>#<tex>\1</tex>#gi;
s#<m>([\s]*?[}][\s]*?)</m>#<tex>\1</tex>#gi;
} @inlist;
return @corrected_list;
}
#------------------------------------------------------------------------------
# supplement_tex_formatting: supplements basic tex formatting with
# ------------------------- corresponding web formatting
#
# - tex \\ -> <tex>\\</tex><web><br /></web>
# - tex *box -> <tex>*box*</tex><web><p /></web>
#
# * Special Note: This function was created in response to
# ------------ difficulties experienced with using <m>
#------------------------------------------------------------------------------
sub supplement_tex_formatting {
map {
s|<m>(\\\\)</m>|<tex>\1</tex><web><br /></web>|g;
s|(<tex>[^<]*?box[^<]*?</tex>)|\1<web><p /></web>|g;
} @inlist;
return @corrected_list;
}
#------------------------------------------------------------------------------
# fix_hints: handles placement and formatting of hintgroups
# ---------
# - removes <hr /> after hint <startouttext /> tag
# - places a tab before each hintgroup line
# - places hintgroup into an array
# - immediately outputs hintgroup within next <*response> tag
# * outputs immediately after <textline />
#------------------------------------------------------------------------------
sub fix_hints {
my @outlist = ();
my $hintmode = 0;
my $pasthintmode = 0;
my $responsemode = 0;
my $pastresponsemode = 0;
my $inlist_index = 0;
my @hint_group = ();
map {
if (m|<hintgroup>|) {
$hintmode = 1;
} elsif (m|</hintgroup>|) {
$hintmode = 0;
} elsif (m|<textline />|) {
$responsemode = 1;
} elsif (m|</[\w]*?response>|) {
$responsemode = 0;
}
if ($hintmode || $pasthintmode) {
s|(<startouttext />)<hr />|\1|g;
push(@hint_group,"\t$_");
$_ = "";
} elsif (!$pasthintmode && @hint_group) {
my $num_repsonse_blocks = 0;
my @inlistcpy = @inlist;
for ($cpyindex = 0; $cpyindex < $inlist_index; $cpyindex++) {
shift(@inlistcpy);
}
foreach (@inlistcpy) {
if (m|<textline />|) {
$num_repsonse_blocks++;
}
}
if (!$responsemode && $pastresponsemode || !$num_repsonse_blocks) {
push(@outlist,@hint_group);
@hint_group = ();
}
}
push(@outlist,$_);
$pasthintmode = $hintmode;
$pastresponsemode = $responsemode;
$inlist_index++;
} @inlist;
return @outlist; #return corrected list
}
#------------------------------------------------------------------------------
# divide_parts: separates a problem into parts based on number of
# ------------ response blocks
#
# - counts number of <*reponse> blocks
# - if there is more than one response block, divides the problem
# into its respective parts
# - adds trailing $stdline
#
# * Calls: "insert_part_tags" subroutine
# ----- "insert_stdline" subroutine
#------------------------------------------------------------------------------
sub divide_parts {
my $parts = 0;
$parts = map m|</[\w]+?response>|, @inlist;
if ($parts > 1) {
@corrected_list = &insert_part_tags(@inlist, $parts);
}
# @corrected_list = &insert_stdline(@corrected_list, $parts);
return @corrected_list;
}
#------------------------------------------------------------------------------
# insert_part_tags: (helper function for "divide_parts" subroutine)
# ---------------- inserts respective <part> tags into problem file
#
# - places the first <part> after <problem>
# - places intermittent </part> and <part> after each response
# - corrects above procedure for the final response
#------------------------------------------------------------------------------
sub insert_part_tags {
my $num_parts = pop(@_);
my $part = 1;
map {
if ($part <= $num_parts) {
s|(<problem>)|\1\n\n<part>|g;
if (m|</[\w]+?response>|) {
s|(</[\w]+?response>)|\1\n</part>\n\n<part>|g;
if ($part++ == $num_parts) {
s|(</[\w]+?response>)\n</part>\n\n<part>|\1|g;
}
}
} # only used for efficiency purposes
s|(</problem>)|</part>\n\1|g;
} @inlist;
return @corrected_list;
}
#------------------------------------------------------------------------------
# remove_single_part_tags: corrects one-part problem syntax
# -----------------------
#
# - removes the part tags the converter places around one-part problems
#------------------------------------------------------------------------------
sub remove_single_part_tags {
my @num_parts = grep m|</part>|, @inlist;
map s|</?part>||g, @inlist unless ($#num_parts);
return @corrected_list;
}
#------------------------------------------------------------------------------
# insert_stdline: (helper function for "divide_parts" subroutine)
# -------------- inserts trailing $stdline
#
# - for multipart problems, inserts the $stdline before </problem>
# - otherwise, inserts it after </problem>
# [placement of $stdline is purely aesthetic]
#------------------------------------------------------------------------------
sub insert_stdline {
my $num_parts = pop(@_);
my $stdline = "\n<startouttext />\n\$stdline\n<br />\n<endouttext />";
if ($num_parts > 1) {
$stdline = "\n</problem>\n" . $stdline;
} else {
$stdline .= "\n\n</problem>";
}
map s|</problem>|$stdline|g, @inlist;
return @corrected_list;
}
#------------------------------------------------------------------------------
# remove_empty_script_blocks: removes <script> blocks emptied during
# -------------------------- prior processing
#
# * Calls: "split_lines" subroutine
# -----
#------------------------------------------------------------------------------
sub remove_empty_script_blocks {
my $nextline = 0;
@inlist = &split_lines(@inlist);
map {
++$nextline;
if (m|<script type="loncapa/perl">|) {
if ($inlist[$nextline] =~ s|</script>||) {
s|<script type="loncapa/perl">||;
}
}
} @inlist;
return @corrected_list;
}
#------------------------------------------------------------------------------
# add_newlines: strategically places additional newline before various
# ------------ sections of code
#
# * Calls: "split_lines" subroutine
# -----
#------------------------------------------------------------------------------
sub add_newlines {
@inlist = &split_lines(@inlist);
map {
s|([\s]*<import>)|\n\1|g;
s|([\s]*<script type="loncapa/perl">)|\n\1|g;
s|([\s]*<startouttext /><hr />)|\n\1|g;
s|([\s]*<block.*?>)|\n\1|g;
s|([\s]*<[\w]+?response[\s>])|\n\1|g;
} @inlist;
return @corrected_list;
}
#------------------------------------------------------------------------------
# split_lines: (helper function for general use)
# ----------- returns an array with each element representing a separate
# line of code that existed in the input array
#
# - splits input array based on \n
# * each element of the new array represents a different line of
# the problem file
# * alleviates problem of detecting \n's within strings
# * all \n's are lost during this operation
# - adds '\n' to the end of each line in new array
#------------------------------------------------------------------------------
sub split_lines {
@inlist = map split(/\n/), @inlist;
@corrected_list = map "$_\n", @inlist;
return @corrected_list;
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to cnvprb CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework / CAPA-converter / conversion_wrapper