Skip to content

Commit

Permalink
Merge pull request #811 from pstaabp/sample-problems-doc
Browse files Browse the repository at this point in the history
Initial checkin of sample problems and parsing script
  • Loading branch information
drgrice1 authored Jul 20, 2023
2 parents 53d6365 + 1775178 commit 6274ae7
Show file tree
Hide file tree
Showing 155 changed files with 13,368 additions and 0 deletions.
162 changes: 162 additions & 0 deletions bin/parse-problem-doc.pl
Original file line number Diff line number Diff line change
@@ -0,0 +1,162 @@
#!/usr/bin/env perl

use strict;
use warnings;
use experimental 'signatures';
use feature 'say';

my $pg_root;

BEGIN {
use Mojo::File qw(curfile);
$pg_root = curfile->dirname->dirname;
}

use lib "$pg_root/lib";

use Mojo::Template;
use File::Basename qw(fileparse basename);
use Getopt::Long;
use File::Copy qw(copy);
use YAML::XS qw(DumpFile);
use Pod::Simple::Search;

use SampleProblemParser qw(parseSampleProblem generateMetadata);

my $problem_dir = "$pg_root/tutorial/sample-problems";

my ($out_dir, $pod_root, $pg_doc_home);
my $verbose = 0;

GetOptions(
"d|problem_dir=s" => \$problem_dir,
"o|out_dir=s" => \$out_dir,
"v|verbose" => \$verbose,
"p|pod_root=s" => \$pod_root,
"h|pg_doc_home=s" => \$pg_doc_home,
);

die "out_dir, pod_root, and pg_doc_home must be provided.\n"
unless $out_dir && $pod_root && $pg_doc_home;

my $mt = Mojo::Template->new(vars => 1);
my $template_dir = "$pg_root/tutorial/templates";

(undef, my $macro_files) = Pod::Simple::Search->new->inc(0)->survey("$pg_root/macros");
my $macro_locations = { map { basename($_) => ($_ =~ s!$pg_root/macros/!!r) =~ s/\.pl/.html/r } keys %$macro_files };

my @problem_types = qw(sample technique snippet);

$pod_root .= '/pg/macros';
mkdir $out_dir unless -d $out_dir;

# Build a hash of all PG files for linking.
my $index_table = generateMetadata($problem_dir, macro_locations => $macro_locations, verbose => $verbose);

for (keys %$index_table) {
renderSampleProblem(
$_ =~ s/.pg$//r,
metadata => $index_table,
macro_locations => $macro_locations,
pod_root => $pod_root,
pg_doc_home => $pg_doc_home,
url_extension => '.html',
problem_dir => $problem_dir,
out_dir => $out_dir,
template_dir => $template_dir,
mt => $mt,
verbose => $verbose
);
}

sub renderSampleProblem ($filename, %global) {
my $relative_dir = $global{metadata}{"$filename.pg"}{dir};
my $path = "$global{problem_dir}/$relative_dir/$filename.pg";
say "Processing file: $path" if $global{verbose};
my $parsed_file = parseSampleProblem($path, %global);

mkdir "$global{out_dir}/$relative_dir" unless -d "$global{out_dir}/$relative_dir";

say "Printing to '$global{out_dir}/$relative_dir/$filename.html'" if $global{verbose};
open(my $html_fh, '>:encoding(UTF-8)', "$global{out_dir}/$relative_dir/$filename.html")
or die qq{Could not open output file "$global{out_dir}/$relative_dir/$filename.html": $!};
print $html_fh $global{mt}->render_file("$global{template_dir}/problem-template.mt",
{ %$parsed_file, %global, filename => "$filename.pg" });
close $html_fh;

# Write the code to a separate file
open(my $pg_fh, '>:encoding(UTF-8)', "$global{out_dir}/$relative_dir/$filename.pg")
or die qq{Could not open output file "$global{out_dir}/$relative_dir/$filename.pg": $!};
print $pg_fh $parsed_file->{code};
close $pg_fh;
say "Printing pg file to '$global{out_dir}/$relative_dir/$filename.pg'" if $global{verbose};
return;
}

# Ouput index files.
for (qw(categories subjects macros techniques)) {
my $options = {
metadata => $index_table,
template_dir => $template_dir,
out_dir => $out_dir,
mt => $mt,
verbose => $verbose,
};
my $params = buildIndex($_, %$options);
writeIndex($params, %$options);
}

sub buildIndex ($type, %options) {
my %labels = (
categories => 'Categories',
subjects => 'Subject Areas',
macros => 'Problems by Macro',
techniques => 'Problem Techniques'
);

my $list = {};
if ($type =~ /^(categories|subjects|macros)$/) {
for my $sample_file (keys %{ $options{metadata} }) {
for my $category (@{ $options{metadata}{$sample_file}{$type} }) {
$list->{$category}{ $options{metadata}{$sample_file}{name} } =
"$options{metadata}{$sample_file}{dir}/" . ($sample_file =~ s/\.pg$/.html/r);
}
}
} elsif ($type eq 'techniques') {
for my $sample_file (keys %{ $options{metadata} }) {
if (grep { $_ eq 'technique' } @{ $options{metadata}{$sample_file}{types} }) {
$list->{ $options{metadata}{$sample_file}{name} } =
"$options{metadata}{$sample_file}{dir}/" . ($sample_file =~ s/\.pg$/.html/r);
}
}
}

return {
label => $labels{$type},
list => $list,
type => $type,
output => "$options{out_dir}/$type.html"
};
}

sub writeIndex ($params, %options) {
say "Creating $params->{label} index" if $options{verbose};
if (open my $FH, '>:encoding(UTF-8)', $params->{output}) {
print $FH $options{mt}->render_file(
"$options{template_dir}/general-layout.mt",
{
sidebar => $options{mt}->render_file("$options{template_dir}/general-sidebar.mt", $params),
main_content => $options{mt}->render_file("$options{template_dir}/general-main.mt", $params),
active => $params->{type}
}
);
close $FH;
}
return;
}

# Copy the PG.js file and CSS file into the output directory.
copy("$pg_root/tutorial/js/PG.js", $out_dir);
copy("$pg_root/tutorial/css/sample-problem.css", $out_dir);

1;
231 changes: 231 additions & 0 deletions lib/SampleProblemParser.pm
Original file line number Diff line number Diff line change
@@ -0,0 +1,231 @@
################################################################################
# WeBWorK Online Homework Delivery System
# Copyright © 2000-2023 The WeBWorK Project, https://github.com/openwebwork
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of either: (a) the GNU General Public License as published by the
# Free Software Foundation; either version 2, or (at your option) any later
# version, or (b) the "Artistic License" which comes with this package.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
# Artistic License for more details.
################################################################################

package SampleProblemParser;
use parent qw(Exporter);

use strict;
use warnings;
use experimental 'signatures';
use feature 'say';

use File::Basename qw(dirname basename);
use File::Find qw(find);
use Pandoc;

our @EXPORT_OK = qw(parseSampleProblem generateMetadata);

=head1 NAME
SampleProblemParser - Parse the documentation in a sample problem in the /doc
directory.
=head2 C<parseSampleProblem>
Parse a PG file with extra documentation comments. The input is the file and a
hash of global variables:
=over
=item C<metadata>: A reference to a hash which has information (name, directory,
types, subjects, categories) of every sample problem file.
=item C<macro_locations>: A reference to a hash of macros to include as links
within a problem.
=item C<pod_root>: The root directory of the POD.
=item C<pg_doc_home>: The url of the pg_doc home.
=item C<url_extension>: The html url extension (including the dot) to use for pg
doc links. The default is the empty string.
=back
=cut

sub parseSampleProblem ($file, %global) {
my $filename = basename($file);
open(my $FH, '<:encoding(UTF-8)', $file) or do {
warn qq{Could not open file "$file": $!};
return {};
};
my @file_contents = <$FH>;
close $FH;

my (@blocks, @doc_rows, @code_rows, @description);
my (%options, $descr, $type, $name);

$global{url_extension} //= '';

while (my $row = shift @file_contents) {
chomp($row);
$row =~ s/\t/ /g;
if ($row =~ /^#:%\s*(categor(y|ies)|types?|subjects?|see_also|name)\s*=\s*(.*)\s*$/) {
# skip this, already parsed.
} elsif ($row =~ /^#:%\s*(.*)?/) {
# The row has the form #:% section = NAME.
# This should parse the previous named section and then reset @doc_rows and @code_rows.
push(
@blocks,
{
%options,
doc => pandoc->convert(markdown => 'html', join("\n", @doc_rows)),
code => join("\n", @code_rows)
}
) if %options;
%options = split(/\s*:\s*|\s*,\s*|\s*=\s*|\s+/, $1);
@doc_rows = ();
@code_rows = ();
} elsif ($row =~ /^#:/) {
# This section is documentation to be parsed.
$row = $row =~ s/^#://r;

# Parse any LINK/PODLINK/PROBLINK commands in the documentation.
if ($row =~ /(POD|PROB)?LINK\('(.*?)'\s*(,\s*'(.*)')?\)/) {
my $link_text = defined($1) ? $1 eq 'POD' ? $2 : $global{metadata}{$2}{name} : $2;
my $url =
defined($1)
? $1 eq 'POD'
? "$global{pod_root}/" . $global{macro_locations}{ $4 // $2 }
: "$global{pg_doc_home}/$global{metadata}{$2}{dir}/" . ($2 =~ s/.pg$/$global{url_extension}/r)
: $4;
$row = $row =~ s/(POD|PROB)?LINK\('(.*?)'\s*(,\s*'(.*)')?\)/[$link_text]($url)/gr;
}

push(@doc_rows, $row);
} elsif ($row =~ /^##\s*(END)?DESCRIPTION\s*$/) {
$descr = $1 ? 0 : 1;
} elsif ($row =~ /^##/ && $descr) {
push(@description, $row =~ s/^##\s*//r);
push(@code_rows, $row);
} else {
push(@code_rows, $row);
}
}

# The last @doc_rows must be parsed then added to the @blocks.
push(
@blocks,
{
%options,
doc => pandoc->convert(markdown => 'html', join("\n", @doc_rows)),
code => join("\n", @code_rows)
}
);

return {
name => $global{metadata}{$filename}{name},
blocks => \@blocks,
code => join("\n", map { $_->{code} } @blocks),
description => join("\n", @description)
};
}

=head2 C<generateMetadata>
Build a hash of metadata for all PG files in the given directory. A reference
to the hash that is built is returned.
=cut

sub generateMetadata ($problem_dir, %options) {
my $index_table = {};

find(
{
wanted => sub {
say "Reading file: $File::Find::name" if $options{verbose};

if ($File::Find::name =~ /\.pg$/) {
my $metadata = parseMetadata($File::Find::name, $problem_dir, $options{macro_locations});
unless (@{ $metadata->{types} }) {
warn "The type of sample problem is missing for $File::Find::name.";
return;
}
unless ($metadata->{name}) {
warn "The name attribute is missing for $File::Find::name.";
return;
}
$index_table->{ basename($File::Find::name) } = $metadata;
}
}
},
$problem_dir
);

return $index_table;
}

my @macros_to_skip = qw(
PGML.pl
PGcourse.pl
PGstandard.pl
);

sub parseMetadata ($path, $problem_dir, $macro_locations = {}) {
open(my $FH, '<:encoding(UTF-8)', $path) or do {
warn qq{Could not open file "$path": $!};
return {};
};
my @file_contents = <$FH>;
close $FH;

my @problem_types = qw(sample technique snippet);

my $metadata = { dir => (dirname($path) =~ s/$problem_dir\/?//r) =~ s/\/*$//r };

while (my $row = shift @file_contents) {
if ($row =~ /^#:%\s*(categor(y|ies)|types?|subjects?|see_also|name)\s*=\s*(.*)\s*$/) {
# The row has the form #:% categories = [cat1, cat2, ...].
my $label = lc($1);
my @opts = $3 =~ /\[(.*)\]/ ? map { $_ =~ s/^\s*|\s*$//r } split(/,/, $1) : ($3);
if ($label =~ /types?/) {
for my $opt (@opts) {
warn "The type of problem must be one of @problem_types"
unless grep { lc($opt) eq $_ } @problem_types;
}
$metadata->{types} = [ map { lc($_) } @opts ];
} elsif ($label =~ /^categor/) {
$metadata->{categories} = \@opts;
} elsif ($label =~ /^subject/) {
$metadata->{subjects} = [ map { lc($_) } @opts ];
} elsif ($label eq 'name') {
$metadata->{name} = $opts[0];
} elsif ($label eq 'see_also') {
$metadata->{related} = \@opts;
}
} elsif ($row =~ /loadMacros\(/) {
chomp($row);
# Parse the macros, which may be on multiple rows.
my $macros = $row;
while ($row && $row !~ /\);\s*$/) {
$row = shift @file_contents;
chomp($row);
$macros .= $row;
}
# Split by commas and pull out the quotes.
my @macros = map {s/['"\s]//gr} split(/\s*,\s*/, $macros =~ s/loadMacros\((.*)\)\;$/$1/r);
$metadata->{macros} = [];
for my $macro (@macros) {
push(@{ $metadata->{macros} }, $macro) unless grep { $_ eq $macro } @macros_to_skip;
}
}
}

return $metadata;
}

1;
Loading

0 comments on commit 6274ae7

Please sign in to comment.