Convert to PGML: add the ability to parse loadMacros if the arguments are in a qw

bin/convert-to-pgml.pl

@@ -8,6 +8,14 @@ =head1 SYNOPSIS
 
     convert-to-pgml -b -s pgml file1.pg file2.pg ...
 
+Options:
+
+    -b|--backup         Create a backup of the original file before converting.
+    -s|--suffix=s       Suffix for the converted files. Default is 'pgml'.
+    -v|--verbose        Print verbose output.
+    -h|--help           Show the help message.
+
+
 =head1 DESCRIPTION
 
 This converts each pg file to PGML formatting.  In particular, text blocks are
@@ -20,14 +28,14 @@ =head1 DESCRIPTION
 to the form C<[_]{}>
 
 Many code features that are no longer needed are removed including
-C<TEXT(beginproblem())>, C<<Context()->texStrings;>> and C<<Context()->normalStrings;>>.
+C<TEXT(beginproblem())>, C<< Context()->texStrings; >> and C<< Context()->normalStrings; >>.
 Any C<ANS> commands are commented out.
 
 The C<loadMacros> command is parsed, the C<PGML.pl> is included and C<MathObjects.pl>
 is removed (because it is loaded by C<PGML.pl>) and C<PGcourse.pl> is added to the
 end of the list.
 
-Note: many of the features are converted correctly, but often there will be errors
+Note: many of the features are converted correctly, but there may be errors
 after the conversion.  Generally after using this script, the PGML style answers
 will need to have their corresponding variable added.
 
@@ -42,42 +50,43 @@ =head2 OPTIONS
 
 =cut
 
-use strict;
-use warnings;
-use experimental 'signatures';
+use Mojo::Base -signatures;
 
 use Mojo::File qw(curfile);
 use Getopt::Long;
+use Pod::Usage;
 
 use lib curfile->dirname->dirname . '/lib';
 
 use WeBWorK::PG::ConvertToPGML qw(convertToPGML);
 
-my $backup  = 0;
-my $verbose = 0;
-my $suffix  = 'pgml';
-
 GetOptions(
-	"b|backup"   => \$backup,
-	"s|suffix=s" => \$suffix,
-	"v|verbose"  => \$verbose,
+	'b|backup'   => \my $backup,
+	's|suffix=s' => \my $suffix,
+	'v|verbose'  => \my $verbose,
+	'h|help'     => \my $show_help
 );
+pod2usage(2) if $show_help || @ARGV == 0;
 
-die 'arguments must have a list of pg files' unless @ARGV > 0;
+$suffix //= 'pgml';
 convertFile($_) for (grep { $_ =~ /\.pg$/ } @ARGV);
 
 sub convertFile ($filename) {
 	my $path = Mojo::File->new($filename);
 	die "The file: $filename does not exist or is not readable" unless -r $path;
 
-	my $pg_source        = $path->slurp;
-	my $converted_source = convertToPGML($pg_source);
+	my $pg_source = $path->slurp;
+	my $result    = convertToPGML($pg_source);
+	if (ref($result) eq 'HASH' && $result->{errors}) {
+		warn "Error parsing $filename. " . $result->{errors} . "\n";
+		return;
+	}
 
-	# copy the original file to a backup and then write the file
+	# Copy the original file to a backup and then write the file.
 	my $new_path    = $backup ? $path : Mojo::File->new($filename =~ s/\.pg/.$suffix/r);
 	my $backup_file = $filename =~ s/\.pg$/.pg.bak/r;
 	$path->copy_to($backup_file) if $backup;
-	$new_path->spurt($converted_source);
+	$new_path->spurt($result->{pgmlCode});
 	print "Writing converted file to $new_path\n"      if $verbose;
 	print "Backing up original file to $backup_file\n" if $verbose && $backup;
 }

lib/WeBWorK/PG/ConvertToPGML.pm

@@ -57,7 +57,7 @@ use parent qw(Exporter);
 use strict;
 use warnings;
 
-our @EXPORT = qw(convertToPGML);
+our @EXPORT_OK = qw(convertToPGML);
 
 =head2 convertToPGML
 
@@ -76,7 +76,7 @@ my @ans_list;
 sub convertToPGML {
 	my ($pg_source) = @_;
 
-	# First get a list of all of the ANS, LABELED_ANS, etc. in the problem.
+	# Get a list of all of the ANS, LABELED_ANS, etc. in the problem.
 	@ans_list = getANS($pg_source);
 
 	my @pgml_block;
@@ -101,29 +101,48 @@ sub convertToPGML {
 		} elsif ($in_pgml_block) {
 			push(@pgml_block, $row);
 		} elsif ($row =~ /loadMacros\(/) {
-			# Parse the macros, which may be on multiple rows.
-			# Remove comments within loadMacros block (should we keep them?)
-			my $macros = $row;
-			while ($row && $row !~ /\);\s*$/) {
+			# Parse the macros, which may be on multiple rows and may be in a qw block.
+			my $macros          = '';
+			my $num_macro_lines = 1; # store the number of lines in the loadMacro so the output is similar to the input.
+			while ($row !~ /\)\s*;/) {
+				# Remove comments within loadMacros block (should we keep them?)
+				$row =~ s/#.*$//;
+				$macros .= $row;
+				++$num_macro_lines;
 				$row = shift @rows;
 				my @mrow = split(/#/, $row);
 				# This only adds the row if there is something relevant to the left of a #
 				$macros .= $mrow[0] if $mrow[0] !~ /^\s*$/;
 			}
-			# Split by commas and pull out the quotes.
-			my @macros =
-				grep { $_ !~ /^#/ }
-				grep {
-					$_ !~
-					/(PGstandard|PGML|PGauxiliaryFunctions|PGbasicmacros|PGanswermacros|MathObjects|PGcourse|AnswerFormatHelp).pl/
+			$macros .= $row;
+
+			my $load_macros_block = parseLoadMacros($macros);
+
+			# If PGML.pl is a macro and there are no BEGIN_TEXT/HINT/SOLUTION blocks
+			# return the original source.
+			return { pgmlCode => $pg_source }
+				if (!defined($load_macros_block->{errors})
+					&& grep { $_ eq 'PGML.pl' } @{ $load_macros_block->{macros} }
+					&& $pg_source !~ /^\s*BEGIN_(TEXT|HINT|SOLUTION)/m);
+
+			return { errors => $load_macros_block->{errors}, pgmlCode => $pg_source } if ($load_macros_block->{errors});
+
+			if ($load_macros_block->{qw_start}) {
+				if ($num_macro_lines > 1) {    # put each macro on a separate line
+					push(@all_lines, 'loadMacros(qw' . $load_macros_block->{qw_start});
+					push(@all_lines, "\t$_") for (@{ $load_macros_block->{macros} });
+					push(@all_lines, $load_macros_block->{qw_end} . ');');
+				} else {
+					push(@all_lines,
+						'loadMacros(qw'
+							. $load_macros_block->{qw_start}
+							. join(' ', @{ $load_macros_block->{macros} })
+							. $load_macros_block->{qw_end} . ');',
+						'');
 				}
-				map {s/['"\s]//gr}
-				split(/\s*,\s*/, $macros =~ s/loadMacros\((.*)\)\;$/$1/r);
-
-			push(@all_lines,
-				'loadMacros('
-					. join(', ', map {"'$_'"} ('PGstandard.pl', 'PGML.pl', @macros, 'PGcourse.pl'))
-					. ');');
+			} else {
+				push(@all_lines, 'loadMacros(' . join(', ', map {"'$_'"} @{ $load_macros_block->{macros} }) . ');', '');
+			}
 		} else {
 			push(@all_lines, cleanUpCode($row));
 		}
@@ -137,7 +156,57 @@ sub convertToPGML {
 			splice(@all_lines, $empty_lines[$n], 1);
 		}
 	}
-	return join "\n", @all_lines;
+	return { pgmlCode => join "\n", @all_lines };
+}
+
+sub parseLoadMacros {
+	my ($macros) = @_;
+
+	my $error_string = 'The loadMacros statement could not be parsed. Check for syntax errors.';
+
+	return { errors => $error_string }
+		if $macros =~ /loadMacros\(.*?\)(.*?);/s && $1 !~ /^\s*$/m;
+
+	my @macros;
+	my ($qw_start, $qw_end);    # the characters if the loadMacros has a qw block.
+	my $qw_matches = { '{' => '}', '(' => ')', '[' => ']', '/' => '/', '|' => '|' };
+
+	# The following can parse loadMacros in the form loadMacros('macro1.pl', 'macro2.pl'); or
+	# loadMacros(qw{macro1.pl macro2.pl});
+	if ($macros =~ /loadMacros\(\s*(.*?)\s*\);/ms) {
+		my @macro_str = split(/\s*,\s*/, $1);
+
+		for my $str (@macro_str) {
+			if ($str =~ /^qw(.)/) {
+				$qw_start = $1;
+				$qw_end   = $qw_matches->{$qw_start};
+				push(@macros, split(/\s+/, $1)) if $str =~ /^qw\Q${qw_start}\E(.*?)\Q${qw_end}\E/;
+			} else {
+				push(@macros, $str);
+			}
+		}
+
+		@macros =
+			grep {
+				$_
+				&& $_ !~
+				/(PGstandard|PGML|PGauxiliaryFunctions|PGbasicmacros|PGanswermacros|MathObjects|PGcourse|AnswerFormatHelp).pl/x
+			}
+			map {s/['"]//gr} @macros;
+
+		# Remove any duplicates:
+		my %seen;
+		@macros = grep { !$seen{$_}++ } @macros;
+	} else {
+		return { errors => $error_string };
+	}
+
+	@macros = ('PGstandard.pl', 'PGML.pl', @macros, 'PGcourse.pl');
+	return {
+		qw_start => $qw_start,
+		qw_end   => $qw_end,
+		macros   => \@macros
+	};
 }
 
 # This subroutine converts a block (passed in as an array ref of strings) to
@@ -214,12 +283,12 @@ sub convertPGMLBlock {
 		}
 
 		# After many other variables have been replaced, replace the variables in the PGML block.
-		# However if not in a {}, assumed to be in an answer blank.
+		# If a variable is inside [_]{}, like '[_]{$a}', then leave it alone.
 		if (my @matches = $row =~ /\$[\w\_]+/g) {
-			for my $m (@matches) {
-				$m =~ s/\$/\\\$/;
-				# Wrap variables in [].  Handle arrays, hashes, array refs and hashrefs.
-				$row =~ s/(?<!\]{)($m+(\[\d+\])?((->)?\{.*?\})?)/[$1]/;
+			my %seen;
+			for my $m (grep { !$seen{$_}++ } @matches) {
+				# $row =~ s/(?<!\{)(\Q$m\E)(?!\})/[$1]/g;
+				$row =~ s/\[_+\]\{\Q$m\E\}(*SKIP)(*F)|(\Q$m\E)/[$1]/g;
 			}
 		}