summaryrefslogtreecommitdiff
path: root/lib/App
diff options
context:
space:
mode:
authorRuss Allbery <rra@cpan.org>2021-12-25 17:14:57 -0800
committerRuss Allbery <rra@cpan.org>2021-12-25 17:14:57 -0800
commitfd9d6faec1031d82b79897b3b34522ff8a7b5823 (patch)
tree265b370977da6e400a9fe573736e5ba6f005c50f /lib/App
parent969f989f3ddd917bde20a45f860dae40e1fe5990 (diff)
parentd49f4587924e350998178e517b800b7268fa6345 (diff)
Update upstream source from tag 'upstream/6.00'
Update to upstream version '6.00' with Debian dir efcd266393ed20522604d3cb0ad24be3e03322ec
Diffstat (limited to 'lib/App')
-rw-r--r--lib/App/DocKnot.pm47
-rw-r--r--lib/App/DocKnot/Command.pm42
-rw-r--r--lib/App/DocKnot/Config.pm47
-rw-r--r--lib/App/DocKnot/Dist.pm51
-rw-r--r--lib/App/DocKnot/Generate.pm27
-rw-r--r--lib/App/DocKnot/Spin.pm140
-rw-r--r--lib/App/DocKnot/Spin/Pointer.pm428
-rw-r--r--lib/App/DocKnot/Spin/RSS.pm80
-rw-r--r--lib/App/DocKnot/Spin/Sitemap.pm11
-rw-r--r--lib/App/DocKnot/Spin/Thread.pm183
-rw-r--r--lib/App/DocKnot/Spin/Versions.pm8
-rw-r--r--lib/App/DocKnot/Update.pm10
-rw-r--r--lib/App/DocKnot/Util.pm172
13 files changed, 937 insertions, 309 deletions
diff --git a/lib/App/DocKnot.pm b/lib/App/DocKnot.pm
index 7a9101f..721bb30 100644
--- a/lib/App/DocKnot.pm
+++ b/lib/App/DocKnot.pm
@@ -11,7 +11,7 @@
# Modules and declarations
##############################################################################
-package App::DocKnot 5.00;
+package App::DocKnot 6.00;
use 5.024;
use autodie;
@@ -20,6 +20,8 @@ use warnings;
use File::BaseDir qw(config_files);
use File::ShareDir qw(module_file);
use File::Spec;
+use Kwalify qw(validate);
+use YAML::XS ();
##############################################################################
# Helper methods
@@ -53,6 +55,36 @@ sub appdata_path {
return $path;
}
+# Load a YAML file with schema checking.
+#
+# $path - Path to the YAML file to load
+# $schema - Name of the schema file against which to check it
+#
+# Returns: Contents of the file as a hash
+# Throws: YAML::XS exception on invalid file
+# Text exception on schema mismatch
+sub load_yaml_file {
+ my ($self, $path, $schema) = @_;
+
+ # Tell YAML::XS to use real booleans. Otherwise, Kwalify is unhappy with
+ # data elements set to false.
+ local $YAML::XS::Boolean = 'JSON::PP';
+
+ # Load the metadata and check it against the schema.
+ my $data_ref = YAML::XS::LoadFile($path);
+ my $schema_path = $self->appdata_path('schema', $schema . '.yaml');
+ my $schema_ref = YAML::XS::LoadFile($schema_path);
+ eval { validate($schema_ref, $data_ref) };
+ if ($@) {
+ my $errors = $@;
+ chomp($errors);
+ die "schema validation for $path failed:\n$errors\n";
+ }
+
+ # Return the verified contents.
+ return $data_ref;
+}
+
##############################################################################
# Module return value and documentation
##############################################################################
@@ -62,7 +94,7 @@ __END__
=for stopwords
Allbery DocKnot docknot MERCHANTABILITY NONINFRINGEMENT sublicense
-submodules
+submodules Kwalify
=head1 NAME
@@ -70,8 +102,8 @@ App::DocKnot - Documentation and software release management
=head1 REQUIREMENTS
-Perl 5.24 or later and the modules File::BaseDir and File::ShareDir, both of
-which are available from CPAN.
+Perl 5.24 or later and the modules File::BaseDir, File::ShareDir, Kwalify, and
+YAML::XS, all of which are available from CPAN.
=head1 DESCRIPTION
@@ -96,6 +128,13 @@ overridden by the user via files in F<$HOME/.config/docknot> or
F</etc/xdg/docknot> (or whatever $XDG_CONFIG_HOME and $XDG_CONFIG_DIRS are set
to). Raises a text exception if the desired file could not be located.
+=item load_yaml_file(PATH, SCHEMA)
+
+Load a YAML file with schema checking. PATH is the path to the file.
+SCHEMA is the name of the schema, which will be loaded from the F<schema>
+directory using appdata_path(). See the description of that method for the
+paths that are searched.
+
=back
=head1 AUTHOR
diff --git a/lib/App/DocKnot/Command.pm b/lib/App/DocKnot/Command.pm
index 093d0b5..7ef45e5 100644
--- a/lib/App/DocKnot/Command.pm
+++ b/lib/App/DocKnot/Command.pm
@@ -10,7 +10,7 @@
# Modules and declarations
##############################################################################
-package App::DocKnot::Command 5.00;
+package App::DocKnot::Command 6.00;
use 5.024;
use autodie;
@@ -60,47 +60,47 @@ use Pod::Usage qw(pod2usage);
# are not set, an error will be thrown.
our %COMMANDS = (
dist => {
- method => 'make_distribution',
- module => 'App::DocKnot::Dist',
+ method => 'make_distribution',
+ module => 'App::DocKnot::Dist',
options => ['distdir|d=s', 'metadata|m=s', 'pgp-key|p=s'],
maximum => 0,
},
generate => {
- method => 'generate_output',
- module => 'App::DocKnot::Generate',
+ method => 'generate_output',
+ module => 'App::DocKnot::Generate',
options => ['metadata|m=s', 'width|w=i'],
maximum => 2,
minimum => 1,
},
'generate-all' => {
- method => 'generate_all',
- module => 'App::DocKnot::Generate',
+ method => 'generate_all',
+ module => 'App::DocKnot::Generate',
options => ['metadata|m=s', 'width|w=i'],
maximum => 0,
},
spin => {
- method => 'spin',
- module => 'App::DocKnot::Spin',
+ method => 'spin',
+ module => 'App::DocKnot::Spin',
options => ['delete|d', 'exclude|e=s@', 'style-url|s=s'],
minimum => 2,
maximum => 2,
},
'spin-rss' => {
- method => 'generate',
- module => 'App::DocKnot::Spin::RSS',
+ method => 'generate',
+ module => 'App::DocKnot::Spin::RSS',
options => ['base|b=s'],
minimum => 1,
maximum => 1,
},
'spin-thread' => {
- method => 'spin_thread_file',
- module => 'App::DocKnot::Spin::Thread',
+ method => 'spin_thread_file',
+ module => 'App::DocKnot::Spin::Thread',
options => ['style-url|s=s'],
maximum => 2,
},
update => {
- method => 'update',
- module => 'App::DocKnot::Update',
+ method => 'update',
+ module => 'App::DocKnot::Update',
options => ['metadata|m=s', 'output|o=s'],
maximum => 0,
},
@@ -293,12 +293,12 @@ App::DocKnot::Command - Run DocKnot commands
=head1 REQUIREMENTS
-Perl 5.24 or later and the modules Date::Parse (part of TimeDate),
-File::BaseDir, File::ShareDir, Git::Repository, Image::Size, IO::Compress::Xz
-(part of IO-Compress-Lzma), IO::Uncompress::Gunzip (part of IO-Compress),
-IPC::Run, IPC::System::Simple, JSON::MaybeXS, Kwalify, List::SomeUtils,
-Perl6::Slurp, Template (part of Template Toolkit), and YAML::XS, all of which
-are available from CPAN.
+Perl 5.24 or later and the modules Date::Language, Date::Parse (both part of
+TimeDate), File::BaseDir, File::ShareDir, Git::Repository, Image::Size,
+IO::Compress::Xz (part of IO-Compress-Lzma), IO::Uncompress::Gunzip (part of
+IO-Compress), IPC::Run, IPC::System::Simple, JSON::MaybeXS, Kwalify,
+List::SomeUtils, Path::Tiny, Perl6::Slurp, Template (part of Template
+Toolkit), and YAML::XS, all of which are available from CPAN.
=head1 DESCRIPTION
diff --git a/lib/App/DocKnot/Config.pm b/lib/App/DocKnot/Config.pm
index f67b489..2eebe32 100644
--- a/lib/App/DocKnot/Config.pm
+++ b/lib/App/DocKnot/Config.pm
@@ -9,7 +9,7 @@
# Modules and declarations
##############################################################################
-package App::DocKnot::Config 5.00;
+package App::DocKnot::Config 6.00;
use 5.024;
use autodie;
@@ -18,44 +18,9 @@ use warnings;
use Carp qw(croak);
use File::BaseDir qw(config_files);
-use Kwalify qw(validate);
use YAML::XS ();
##############################################################################
-# Helper methods
-##############################################################################
-
-# Load a YAML file with schema checking.
-#
-# $path - Path to the YAML file to load
-# $schema - Name of the schema file against which to check it
-#
-# Returns: Contents of the file as a hash
-# Throws: YAML::XS exception on invalid file
-# Text exception on schema mismatch
-sub _load_yaml_file {
- my ($self, $path, $schema) = @_;
-
- # Tell YAML::XS to use real booleans. Otherwise, Kwalify is unhappy with
- # data elements set to false.
- local $YAML::XS::Boolean = 'JSON::PP';
-
- # Load the metadata and check it against the schema.
- my $data_ref = YAML::XS::LoadFile($path);
- my $schema_path = $self->appdata_path('schema', $schema);
- my $schema_ref = YAML::XS::LoadFile($schema_path);
- eval { validate($schema_ref, $data_ref) };
- if ($@) {
- my $errors = $@;
- chomp($errors);
- die "schema validation for $path failed:\n$errors\n";
- }
-
- # Return the verified contents.
- return $data_ref;
-}
-
-##############################################################################
# Public Interface
##############################################################################
@@ -92,7 +57,7 @@ sub config {
my ($self) = @_;
# Load the package metadata.
- my $data_ref = $self->_load_yaml_file($self->{metadata}, 'docknot.yaml');
+ my $data_ref = $self->load_yaml_file($self->{metadata}, 'docknot');
# build.install defaults to true.
if (!exists($data_ref->{build}{install})) {
@@ -109,14 +74,14 @@ sub config {
}
# Expand the package license into license text.
- my $license = $data_ref->{license}{name};
+ my $license = $data_ref->{license}{name};
my $licenses_path = $self->appdata_path('licenses.yaml');
- my $licenses_ref = YAML::XS::LoadFile($licenses_path);
+ my $licenses_ref = YAML::XS::LoadFile($licenses_path);
if (!exists($licenses_ref->{$license})) {
die "unknown license $license\n";
}
$data_ref->{license}{summary} = $licenses_ref->{$license}{summary};
- $data_ref->{license}{text} = $licenses_ref->{$license}{text};
+ $data_ref->{license}{text} = $licenses_ref->{$license}{text};
# Return the resulting configuration.
return $data_ref;
@@ -136,7 +101,7 @@ sub global_config {
if (!defined($config_path)) {
return {};
}
- my $data_ref = $self->_load_yaml_file($config_path, 'config.yaml');
+ my $data_ref = $self->load_yaml_file($config_path, 'config');
# Return the resulting configuration.
return $data_ref;
diff --git a/lib/App/DocKnot/Dist.pm b/lib/App/DocKnot/Dist.pm
index 1db9b13..50d3b9b 100644
--- a/lib/App/DocKnot/Dist.pm
+++ b/lib/App/DocKnot/Dist.pm
@@ -10,7 +10,7 @@
# Modules and declarations
##############################################################################
-package App::DocKnot::Dist 5.00;
+package App::DocKnot::Dist 6.00;
use 5.024;
use autodie;
@@ -23,12 +23,13 @@ use Cwd qw(getcwd);
use File::Copy qw(move);
use File::Find qw(find);
use File::Path qw(remove_tree);
-use IO::Compress::Xz ();
+use Git::Repository ();
+use IO::Compress::Xz ();
use IO::Uncompress::Gunzip ();
use IPC::Run qw(run);
use IPC::System::Simple qw(systemx);
use List::SomeUtils qw(lastval);
-use List::Util qw(any);
+use List::Util qw(any first);
# Base commands to run for various types of distributions. Additional
# variations may be added depending on additional configuration parameters.
@@ -138,7 +139,7 @@ sub _expected_dist_files {
# Throws: Text exception if no gzip tarball was found
sub _find_gzip_tarball {
my ($self, $path, $prefix) = @_;
- my @files = $self->_find_matching_tarballs($path, $prefix);
+ my @files = $self->_find_matching_tarballs($path, $prefix);
my $gzip_file = lastval { m{ [.]tar [.]gz \z }xms } @files;
if (!defined($gzip_file)) {
die "cannot find gzip tarball for $prefix in $path\n";
@@ -174,14 +175,14 @@ sub _generate_compression_formats {
my @files = $self->_find_matching_tarballs($path, $prefix);
if (!any { m{ [.]tar [.]xz \z }xms } @files) {
my $gzip_file = lastval { m{ [.]tar [.]gz \z }xms } @files;
- my $xz_file = $gzip_file;
+ my $xz_file = $gzip_file;
$xz_file =~ s{ [.]gz \z }{.xz}xms;
my $gzip_path = File::Spec->catfile($path, $gzip_file);
- my $xz_path = File::Spec->catfile($path, $xz_file);
+ my $xz_path = File::Spec->catfile($path, $xz_file);
# Open the input and output files.
my $gzip_fh = IO::Uncompress::Gunzip->new($gzip_path);
- my $xz_fh = IO::Compress::Xz->new($xz_path);
+ my $xz_fh = IO::Compress::Xz->new($xz_path);
# Read from the gzip file and write to the xz-compressed file.
my $buffer;
@@ -247,7 +248,7 @@ sub _sign_tarballs {
for my $file (@files) {
my $tarball_path = File::Spec->catdir($path, $file);
systemx(
- $self->{gpg}, '--detach-sign', '--armor', '-u',
+ $self->{gpg}, '--detach-sign', '--armor', '-u',
$self->{pgp_key}, $tarball_path,
);
}
@@ -292,6 +293,7 @@ sub new {
}
# Create and return the object.
+ #<<<
my $self = {
config => $config_reader->config(),
distdir => $distdir,
@@ -299,6 +301,7 @@ sub new {
perl => $args_ref->{perl},
pgp_key => $args_ref->{pgp_key} // $global_config_ref->{pgp_key},
};
+ #>>>
bless($self, $class);
return $self;
}
@@ -317,7 +320,7 @@ sub check_dist {
my ($self, $source, $tarball) = @_;
my @expected = $self->_expected_dist_files(getcwd());
my %expected = map { $_ => 1 } @expected;
- my $archive = Archive::Tar->new($tarball);
+ my $archive = Archive::Tar->new($tarball);
for my $file ($archive->list_files()) {
$file =~ s{ \A [^/]* / }{}xms;
delete $expected{$file};
@@ -332,8 +335,8 @@ sub check_dist {
# Returns: List of commands, each of which is a list of strings representing
# a command and its arguments
sub commands {
- my ($self) = @_;
- my $type = $self->{config}{build}{type};
+ my ($self) = @_;
+ my $type = $self->{config}{build}{type};
my @commands = map { [@$_] } $COMMANDS{$type}->@*;
# Special-case: If a specific path to Perl was configured, use that path
@@ -390,13 +393,19 @@ sub make_distribution {
}
# Export the Git repository into a new directory.
- my @git = (
- 'git', 'archive',
- "--remote=$source", "--prefix=${prefix}/",
- 'master',
+ my $repo = Git::Repository->new(work_tree => $source);
+ my @branches = $repo->run(
+ 'for-each-ref' => '--format=%(refname:short)', 'refs/heads/',
);
- my @tar = qw(tar xf -);
- run(\@git, q{|}, \@tar) or die "@git | @tar failed with status $?\n";
+ my $head = first { $_ eq 'main' || $_ eq 'master' } @branches;
+ my $archive = $repo->command(archive => "--prefix=${prefix}/", $head);
+ run([qw(tar xf -)], '<', $archive->stdout)
+ or die "git archive | tar xf - failed with status $?\n";
+ $archive->close();
+
+ if ($archive->exit != 0) {
+ die 'git archive failed with status ' . $archive->exit . "\n";
+ }
# Change to that directory and run the configured commands.
chdir($prefix);
@@ -461,9 +470,9 @@ App::DocKnot::Dist - Prepare a distribution tarball
=head1 REQUIREMENTS
Git, Perl 5.24 or later, and the modules File::BaseDir, File::ShareDir,
-IO::Compress::Xz (part of IO-Compress-Lzma), IO::Uncompress::Gunzip (part of
-IO-Compress), IPC::Run, IPC::System::Simple, Kwalify, List::SomeUtils, and
-YAML::XS, all of which are available from CPAN.
+Git::Repository, IO::Compress::Xz (part of IO-Compress-Lzma),
+IO::Uncompress::Gunzip (part of IO-Compress), IPC::Run, IPC::System::Simple,
+Kwalify, List::SomeUtils, and YAML::XS, all of which are available from CPAN.
The tools to build whatever type of software distribution is being prepared
are also required, since the distribution is built and tested as part of
@@ -557,6 +566,8 @@ an implementation detail of make_distribution().
=item make_distribution()
Generate distribution tarballs in the C<destdir> directory provided to new().
+The distribution will be generated from the first branch found named either
+C<main> or C<master>.
If C<destdir> already contains a subdirectory whose name matches the
C<tarname> of the distribution, it will be forcibly removed. In order to
diff --git a/lib/App/DocKnot/Generate.pm b/lib/App/DocKnot/Generate.pm
index 49b73a3..8caa7a8 100644
--- a/lib/App/DocKnot/Generate.pm
+++ b/lib/App/DocKnot/Generate.pm
@@ -10,7 +10,7 @@
# Modules and declarations
##############################################################################
-package App::DocKnot::Generate 5.00;
+package App::DocKnot::Generate 6.00;
use 5.024;
use autodie;
@@ -25,7 +25,7 @@ use Text::Wrap qw(wrap);
# Default output files for specific templates.
my %DEFAULT_OUTPUT = (
- 'readme' => 'README',
+ 'readme' => 'README',
'readme-md' => 'README.md',
);
@@ -77,11 +77,11 @@ sub _code_for_copyright {
my $notice;
for my $copyright ($copyrights_ref->@*) {
my $holder = $copyright->{holder};
- my $years = $copyright->{years};
+ my $years = $copyright->{years};
# Build the initial notice with the word copyright and the years.
my $text = 'Copyright ' . $copyright->{years};
- local $Text::Wrap::columns = $self->{width} + 1;
+ local $Text::Wrap::columns = $self->{width} + 1;
local $Text::Wrap::unexpand = 0;
$text = wrap($prefix, $prefix . q{ } x 4, $text);
@@ -174,11 +174,12 @@ sub _code_for_to_text {
# numeric references, and accumulate the mapping of numbers to URLs in
# %urls. Then, add to the end of the paragraph the references and
# URLs.
- my $ref = 1;
+ my $ref = 1;
my @paragraphs = split(m{ \n\n }xms, $text);
for my $para (@paragraphs) {
my %urls;
- while ($para =~ s{ \[([^\]]+)\] [(] (\S+) [)] }{$1 [$ref]}xms) {
+ my $regex = qr{ \[([^\]]+)\] [(] (\S+) [)] }xms;
+ while ($para =~ s{$regex}{$1 [$ref]}xms) {
$urls{$ref} = $2;
$ref++;
}
@@ -375,9 +376,9 @@ sub _wrap_paragraph {
$para =~ s{ \n(\S) }{ $1}xmsg;
# Force locally correct configuration of Text::Wrap.
- local $Text::Wrap::break = qr{\s+}xms;
- local $Text::Wrap::columns = $self->{width} + 1;
- local $Text::Wrap::huge = 'overflow';
+ local $Text::Wrap::break = qr{\s+}xms;
+ local $Text::Wrap::columns = $self->{width} + 1;
+ local $Text::Wrap::huge = 'overflow';
local $Text::Wrap::unexpand = 0;
# Do the wrapping. This modifies @paragraphs in place.
@@ -447,7 +448,7 @@ sub new {
# Create and return the object.
my $self = {
config => $config,
- width => $args_ref->{width} // 74,
+ width => $args_ref->{width} // 74,
};
bless($self, $class);
return $self;
@@ -472,10 +473,10 @@ sub generate {
my %vars = %{$data_ref};
# Add code references for our defined helper functions.
- $vars{center} = $self->_code_for_center;
+ $vars{center} = $self->_code_for_center;
$vars{copyright} = $self->_code_for_copyright($data_ref->{copyrights});
- $vars{indent} = $self->_code_for_indent;
- $vars{to_text} = $self->_code_for_to_text;
+ $vars{indent} = $self->_code_for_indent;
+ $vars{to_text} = $self->_code_for_to_text;
$vars{to_thread} = $self->_code_for_to_thread;
# Ensure we were given a valid template.
diff --git a/lib/App/DocKnot/Spin.pm b/lib/App/DocKnot/Spin.pm
index 655aa64..73666e0 100644
--- a/lib/App/DocKnot/Spin.pm
+++ b/lib/App/DocKnot/Spin.pm
@@ -11,25 +11,26 @@
# Modules and declarations
##############################################################################
-package App::DocKnot::Spin 5.00;
+package App::DocKnot::Spin 6.00;
use 5.024;
use autodie;
use warnings;
+use App::DocKnot::Spin::Pointer;
use App::DocKnot::Spin::RSS;
use App::DocKnot::Spin::Sitemap;
use App::DocKnot::Spin::Thread;
use App::DocKnot::Spin::Versions;
+use App::DocKnot::Util qw(is_newer print_checked print_fh);
use Carp qw(croak);
use Cwd qw(getcwd realpath);
use File::Basename qw(fileparse);
use File::Copy qw(copy);
use File::Find qw(find finddepth);
-use File::Spec ();
+use File::Spec ();
use Git::Repository ();
-use List::SomeUtils qw(all);
-use IPC::System::Simple qw(capture systemx);
+use IPC::System::Simple qw(capture);
use Pod::Thread 3.00 ();
use POSIX qw(strftime);
@@ -46,51 +47,9 @@ my @EXCLUDES = (
my $URL = 'https://www.eyrie.org/~eagle/software/web/';
##############################################################################
-# Utility functions
-##############################################################################
-
-# Check if a file, which may not exist, is newer than another list of files.
-#
-# $file - File whose timestamp to compare
-# @others - Other files to compare against
-#
-# Returns: True if $file exists and is newer than @others, false otherwise
-sub _is_newer {
- my ($file, @others) = @_;
- return if !-e $file;
- my $file_mtime = (stat($file))[9];
- my @others_mtimes = map { (stat)[9] } @others;
- return all { $file_mtime >= $_ } @others_mtimes;
-}
-
-##############################################################################
# Output
##############################################################################
-# print with error checking. autodie unfortunately can't help us because
-# print can't be prototyped and hence can't be overridden.
-sub _print_checked {
- my (@args) = @_;
- print @args or croak('print failed');
- return;
-}
-
-# print with error checking and an explicit file handle. autodie
-# unfortunately can't help us because print can't be prototyped and
-# hence can't be overridden.
-#
-# $fh - Output file handle
-# $file - File name for error reporting
-# @args - Remaining arguments to print
-#
-# Returns: undef
-# Throws: Text exception on output failure
-sub _print_fh {
- my ($fh, $file, @args) = @_;
- print {$fh} @args or croak("cannot write to $file: $!");
- return;
-}
-
# Build te page footer, which consists of the navigation links, the regular
# signature, and the last modified date.
#
@@ -106,7 +65,7 @@ sub _print_fh {
# Returns: HTML output
sub _footer {
my ($self, $source, $out_path, $id, @templates) = @_;
- my $output = q{};
+ my $output = q{};
my $in_tree = 0;
if ($self->{source} && $source =~ m{ \A \Q$self->{source}\E }xms) {
$in_tree = 1;
@@ -116,7 +75,7 @@ sub _footer {
if ($self->{sitemap} && $self->{output}) {
my $page = $out_path;
$page =~ s{ \A \Q$self->{output}\E }{}xms;
- $output .= join(q{}, $self->{sitemap}->navbar($page));
+ $output .= join(q{}, $self->{sitemap}->navbar($page)) . "\n";
}
# Figure out the modification dates. Use the RCS/CVS Id if available,
@@ -187,15 +146,15 @@ sub _write_converter_output {
if ($self->{sitemap} && $line =~ m{ \A </head> }xmsi) {
my @links = $self->{sitemap}->links($page);
if (@links) {
- _print_fh($out_fh, $output, @links);
+ print_fh($out_fh, $output, @links);
}
}
- _print_fh($out_fh, $output, $line);
+ print_fh($out_fh, $output, $line);
if ($line =~ m{ <body }xmsi) {
if ($self->{sitemap}) {
my @navbar = $self->{sitemap}->navbar($page);
if (@navbar) {
- _print_fh($out_fh, $output, @navbar);
+ print_fh($out_fh, $output, @navbar);
}
}
last;
@@ -209,13 +168,13 @@ sub _write_converter_output {
my $line;
while (defined($line = shift($page_ref->@*))) {
last if $line =~ m{ </body> }xmsi;
- _print_fh($out_fh, $output, $line);
+ print_fh($out_fh, $output, $line);
}
# Add the footer and finish with the output.
- _print_fh($out_fh, $output, $footer->($blurb, $docid));
+ print_fh($out_fh, $output, $footer->($blurb, $docid));
if (defined($line)) {
- _print_fh($out_fh, $output, $line, $page_ref->@*);
+ print_fh($out_fh, $output, $line, $page_ref->@*);
}
close($out_fh);
return;
@@ -232,7 +191,7 @@ sub _write_converter_output {
sub _cl2xhtml {
my ($self, $source, $output, $options, $style) = @_;
$style ||= $self->{style_url} . 'changelog.css';
- my @page = capture("cl2xhtml $options -s $style $source");
+ my @page = capture("cl2xhtml $options -s $style $source");
my $footer = sub {
my ($blurb, $id) = @_;
if ($blurb) {
@@ -261,7 +220,7 @@ sub _cvs2xhtml {
$options .= " -s $style";
# Run the converter and write the output.
- my @page = capture("(cd $dir && cvs log $name) | cvs2xhtml $options");
+ my @page = capture("(cd $dir && cvs log $name) | cvs2xhtml $options");
my $footer = sub {
my ($blurb, $id, $file) = @_;
if ($blurb) {
@@ -279,7 +238,7 @@ sub _cvs2xhtml {
sub _faq2html {
my ($self, $source, $output, $options, $style) = @_;
$style ||= $self->{style_url} . 'faq.css';
- my @page = capture("faq2html $options -s $style $source");
+ my @page = capture("faq2html $options -s $style $source");
my $footer = sub {
my ($blurb, $id, $file) = @_;
if ($blurb) {
@@ -357,9 +316,9 @@ sub _read_pointer {
# Read the pointer file.
open(my $pointer, '<', $file);
- my $master = <$pointer>;
+ my $master = <$pointer>;
my $options = <$pointer>;
- my $style = <$pointer>;
+ my $style = <$pointer>;
close($pointer);
# Clean up the contents.
@@ -397,7 +356,7 @@ sub _process_file {
return;
}
}
- my $input = $File::Find::name;
+ my $input = $File::Find::name;
my $output = $input;
$output =~ s{ \A \Q$self->{source}\E }{$self->{output}}xms
or die "input file $file out of tree\n";
@@ -407,12 +366,14 @@ sub _process_file {
# Conversion rules for pointers. The key is the extension, the first
# value is the name of the command for the purposes of output, and the
# second is the name of the method to run.
+ #<<<
my %rules = (
changelog => ['cl2xhtml', '_cl2xhtml'],
faq => ['faq2html', '_faq2html'],
log => ['cvs2xhtml', '_cvs2xhtml'],
rpod => ['pod2thread', '_pod2html'],
);
+ #>>>
# Figure out what to do with the input.
if (-d $file) {
@@ -420,15 +381,23 @@ sub _process_file {
if (-e $output && !-d $output) {
die "cannot replace $output with a directory\n";
} elsif (!-d $output) {
- _print_checked("Creating $shortout\n");
+ print_checked("Creating $shortout\n");
mkdir($output, 0755);
}
my $rss_path = File::Spec->catfile($file, '.rss');
if (-e $rss_path) {
$self->{rss}->generate($rss_path, $file);
}
+ } elsif ($file =~ m{ [.] spin \z }xms) {
+ $output =~ s{ [.] spin \z }{.html}xms;
+ $shortout =~ s{ [.] spin \z }{.html}xms;
+ $self->{generated}{$output} = 1;
+ if ($self->{pointer}->is_out_of_date($input, $output)) {
+ print_checked("Converting $shortout\n");
+ $self->{pointer}->spin_pointer($input, $output);
+ }
} elsif ($file =~ m{ [.] th \z }xms) {
- $output =~ s{ [.] th \z }{.html}xms;
+ $output =~ s{ [.] th \z }{.html}xms;
$shortout =~ s{ [.] th \z }{.html}xms;
$self->{generated}{$output} = 1;
@@ -438,29 +407,29 @@ sub _process_file {
my $relative = $input;
$relative =~ s{ ^ \Q$self->{source}\E / }{}xms;
my $time = $self->{versions}->latest_release($relative);
- return if _is_newer($output, $file) && (stat($output))[9] >= $time;
+ return if is_newer($output, $file) && (stat($output))[9] >= $time;
} else {
- return if _is_newer($output, $file);
+ return if is_newer($output, $file);
}
# The output file is not newer. Respin it.
- _print_checked("Spinning $shortout\n");
+ print_checked("Spinning $shortout\n");
$self->{thread}->spin_thread_file($input, $output);
} else {
my ($extension) = ($file =~ m{ [.] ([^.]+) \z }xms);
if (defined($extension) && $rules{$extension}) {
my ($name, $sub) = $rules{$extension}->@*;
- $output =~ s{ [.] \Q$extension\E \z }{.html}xms;
+ $output =~ s{ [.] \Q$extension\E \z }{.html}xms;
$shortout =~ s{ [.] \Q$extension\E \z }{.html}xms;
$self->{generated}{$output} = 1;
my ($source, $options, $style) = $self->_read_pointer($input);
- return if _is_newer($output, $input, $source);
- _print_checked("Running $name for $shortout\n");
+ return if is_newer($output, $input, $source);
+ print_checked("Running $name for $shortout\n");
$self->$sub($source, $output, $options, $style);
} else {
$self->{generated}{$output} = 1;
- return if _is_newer($output, $file);
- _print_checked("Updating $shortout\n");
+ return if is_newer($output, $file);
+ print_checked("Updating $shortout\n");
copy($file, $output)
or die "copy of $input to $output failed: $!\n";
}
@@ -483,7 +452,7 @@ sub _delete_files {
return if $self->{generated}{$file};
my $shortfile = $file;
$shortfile =~ s{ ^ \Q$self->{output}\E }{...}xms;
- _print_checked("Deleting $shortfile\n");
+ print_checked("Deleting $shortfile\n");
if (-d $file) {
rmdir($file);
} else {
@@ -522,12 +491,14 @@ sub new {
}
# Create and return the object.
+ #<<<
my $self = {
delete => $args_ref->{delete},
excludes => [@excludes],
rss => App::DocKnot::Spin::RSS->new(),
style_url => $style_url,
};
+ #>>>
bless($self, $class);
return $self;
}
@@ -555,7 +526,7 @@ sub spin {
# Canonicalize and check output.
if (!-d $output) {
- _print_checked("Creating $output\n");
+ print_checked("Creating $output\n");
mkdir($output, 0755);
}
$output = realpath($output) or die "cannot canonicalize $output: $!\n";
@@ -584,6 +555,7 @@ sub spin {
}
# Create a new thread converter object.
+ #<<<
$self->{thread} = App::DocKnot::Spin::Thread->new(
{
output => $output,
@@ -593,15 +565,24 @@ sub spin {
versions => $self->{versions},
},
);
+ #>>>
- # Process the input tree.
- find(
+ # Create the processor for pointers.
+ #<<<
+ $self->{pointer} = App::DocKnot::Spin::Pointer->new(
{
- preprocess => sub { my @files = sort(@_); return @files },
- wanted => sub { $self->_process_file(@_) },
+ output => $output,
+ sitemap => $self->{sitemap},
+ 'style-url' => $self->{style_url},
+ thread => $self->{thread},
},
- $input,
);
+ #>>>
+
+ # Process the input tree.
+ my $preprocess = sub { my @files = sort(@_); return @files };
+ my $wanted = sub { $self->_process_file(@_) };
+ find({ preprocess => $preprocess, wanted => $wanted }, $input);
if ($self->{delete}) {
finddepth(sub { $self->_delete_files(@_) }, $output);
}
@@ -632,8 +613,9 @@ App::DocKnot::Spin - Static site builder supporting thread macro language
=head1 REQUIREMENTS
-Perl 5.24 or later and the modules Git::Repository, Image::Size, and
-Pod::Thread, all of which are available from CPAN. Also expects to find
+Perl 5.24 or later and the modules Git::Repository, Image::Size,
+List::SomeUtils, Path::Tiny, Pod::Thread, Template (part of Template Toolkit),
+and YAML::XS, all of which are available from CPAN. Also expects to find
B<faq2html>, B<cvs2xhtml>, and B<cl2xhtml> on the user's PATH to convert
certain types of files.
diff --git a/lib/App/DocKnot/Spin/Pointer.pm b/lib/App/DocKnot/Spin/Pointer.pm
new file mode 100644
index 0000000..05aa9ac
--- /dev/null
+++ b/lib/App/DocKnot/Spin/Pointer.pm
@@ -0,0 +1,428 @@
+# Generate HTML from a pointer to an external file.
+#
+# The input tree for spin may contain pointers to external files in various
+# formats. This module parses those pointer files and performs the conversion
+# of those external files into HTML.
+#
+# SPDX-License-Identifier: MIT
+
+##############################################################################
+# Modules and declarations
+##############################################################################
+
+package App::DocKnot::Spin::Pointer 6.00;
+
+use 5.024;
+use autodie;
+use parent qw(App::DocKnot);
+use warnings;
+
+use App::DocKnot::Config;
+use App::DocKnot::Util qw(is_newer print_fh);
+use Carp qw(croak);
+use Encode qw(decode encode);
+use File::BaseDir qw(config_files);
+use IPC::System::Simple qw(capturex);
+use Kwalify qw(validate);
+use POSIX qw(strftime);
+use Template ();
+use YAML::XS ();
+
+# The URL to the software page for all of my web page generation software,
+# used to embed a link to the software that generated the page.
+my $URL = 'https://www.eyrie.org/~eagle/software/web/';
+
+##############################################################################
+# Format conversions
+##############################################################################
+
+# Convert a Markdown file to HTML.
+#
+# $data_ref - Data from the pointer file
+# path - Path to the Markdown file to convert
+# style - Style sheet to use
+# $output - Path to the output file
+#
+# Throws: Text exception on conversion failure
+sub _spin_markdown {
+ my ($self, $data_ref, $output) = @_;
+ my $source = $data_ref->{path};
+
+ # Do the Markdown conversion using pandoc.
+ my $html = capturex(
+ $self->{pandoc_path}, '--wrap=preserve', '-f', 'markdown',
+ '-t', 'html', $source,
+ );
+
+ # Pull the title out of the contents of the <h1> header if not set.
+ my $title = $data_ref->{title};
+ if (!defined($title)) {
+ ($title) = $html =~ m{ <h1 [^>]+ > (.*?) </h1> }xms;
+ }
+
+ # Construct the template variables.
+ my ($links, $navbar, $style);
+ if ($self->{sitemap}) {
+ my $page = $output;
+ $page =~ s{ \A \Q$self->{output}\E }{}xms;
+ my @links = $self->{sitemap}->links($page);
+ if (@links) {
+ $links = join(q{}, @links);
+ }
+ my @navbar = $self->{sitemap}->navbar($page);
+ if (@navbar) {
+ $navbar = join(q{}, @navbar);
+ }
+ }
+ if ($data_ref->{style}) {
+ $style = $self->{style_url} . $data_ref->{style};
+ }
+ #<<<
+ my %vars = (
+ docknot_url => $URL,
+ html => decode('utf-8', $html),
+ links => $links,
+ modified => strftime('%Y-%m-%d', gmtime((stat($source))[9])),
+ navbar => $navbar,
+ now => strftime('%Y-%m-%d', gmtime()),
+ style => $style,
+ title => $title,
+ );
+ #>>>
+
+ # Construct the output page from those template variables.
+ my $result;
+ $self->{template}->process($self->{template_path}, \%vars, \$result)
+ or croak($self->{template}->error());
+
+ # Write the result to the output file.
+ open(my $outfh, '>', $output);
+ print_fh($outfh, $output, encode('utf-8', $result));
+ close($outfh);
+ return;
+}
+
+# Convert a POD file to HTML.
+#
+# $data_ref - Data from the pointer file
+# options - Hash of conversion options
+# contents - Whether to add a table of contents
+# navbar - Whether to add a navigation bar
+# path - Path to the POD file to convert
+# style - Style sheet to use
+# $output - Path to the output file
+#
+# Throws: Text exception on conversion failure
+sub _spin_pod {
+ my ($self, $data_ref, $output) = @_;
+ my $source = $data_ref->{path};
+
+ # Construct the Pod::Thread formatter object.
+ #<<<
+ my %options = (
+ contents => $data_ref->{options}{contents},
+ style => $data_ref->{style} // 'pod',
+ );
+ #<<<
+ if (exists($data_ref->{options}{navbar})) {
+ $options{navbar} = $data_ref->{options}{navbar};
+ } else {
+ $options{navbar} = 1;
+ }
+ if (exists($data_ref->{title})) {
+ $options{title} = $data_ref->{title};
+ }
+ my $podthread = Pod::Thread->new(%options);
+
+ # Convert the POD to thread.
+ my $data;
+ $podthread->output_string(\$data);
+ $podthread->parse_file($source);
+
+ # Spin that page into HTML.
+ $self->{thread}->spin_thread_output($data, $source, 'POD', $output);
+ return;
+}
+
+##############################################################################
+# Public interface
+##############################################################################
+
+# Create a new HTML converter for pointers. This object can (and should) be
+# reused for all pointer conversions done while spinning a tree of files.
+#
+# $args - Anonymous hash of arguments with the following keys:
+# output - Root of the output tree
+# sitemap - App::DocKnot::Spin::Sitemap object
+# style-url - Partial URL to style sheets
+# thread - App::DocKnot::Spin::Thread object
+#
+# Returns: Newly created object
+# Throws: Text exception on failure to initialize Template Toolkit
+sub new {
+ my ($class, $args_ref) = @_;
+
+ # Get the configured path to pandoc, if any.
+ my $config_reader = App::DocKnot::Config->new();
+ my $global_config_ref = $config_reader->global_config();
+ my $pandoc = $global_config_ref->{pandoc} // 'pandoc';
+
+ # Add a trailing slash to the partial URL for style sheets.
+ my $style_url = $args_ref->{'style-url'} // q{};
+ if ($style_url) {
+ $style_url =~ s{ /* \z }{/}xms;
+ }
+
+ # Create and return the object.
+ my $tt = Template->new({ ABSOLUTE => 1 }) or croak(Template->error());
+ #<<<
+ my $self = {
+ output => $args_ref->{output},
+ pandoc_path => $pandoc,
+ sitemap => $args_ref->{sitemap},
+ style_url => $style_url,
+ template => $tt,
+ thread => $args_ref->{thread},
+ };
+ #>>>
+ bless($self, $class);
+ $self->{template_path} = $self->appdata_path('templates', 'html.tmpl');
+ return $self;
+}
+
+# Check if the result of a pointer file needs to be regenerated.
+#
+# $pointer - Pointer file to process
+# $output - Corresponding output path
+#
+# Returns: True if the output file does not exist or has a modification date
+# older than either the pointer file or the underlying source file,
+# false otherwise
+# Throws: YAML::XS exception on invalid pointer
+sub is_out_of_date {
+ my ($self, $pointer, $output) = @_;
+ my $data_ref = $self->load_yaml_file($pointer, 'pointer');
+ if (!-e $data_ref->{path}) {
+ die "$pointer: path $data_ref->{path} does not exist\n";
+ }
+ return !is_newer($output, $pointer, $data_ref->{path});
+}
+
+# Process a given pointer file.
+#
+# $pointer - Pointer file to process
+# $output - Corresponding output path
+#
+# Throws: YAML::XS exception on invalid pointer
+# Text exception for missing input file
+# Text exception on failure to convert the file
+sub spin_pointer {
+ my ($self, $pointer, $output, $options_ref) = @_;
+ my $data_ref = $self->load_yaml_file($pointer, 'pointer');
+ $data_ref->{options} //= {};
+
+ # Dispatch to the appropriate conversion function.
+ if ($data_ref->{format} eq 'markdown') {
+ $self->_spin_markdown($data_ref, $output);
+ } elsif ($data_ref->{format} eq 'pod') {
+ $self->_spin_pod($data_ref, $output);
+ } else {
+ die "$pointer: unknown output format $data_ref->{format}\n";
+ }
+ return;
+}
+
+##############################################################################
+# Module return value and documentation
+##############################################################################
+
+1;
+
+__END__
+
+=for stopwords
+Allbery DocKnot MERCHANTABILITY NONINFRINGEMENT Kwalify sublicense unstyled
+navbar
+
+=head1 NAME
+
+App::DocKnot::Spin::Pointer - Generate HTML from a pointer to an external file
+
+=head1 SYNOPSIS
+
+ use App::DocKnot::Spin::Pointer;
+ use App::DocKnot::Spin::Sitemap;
+
+ my $sitemap = App::DocKnot::Spin::Sitemap->new('/input/.sitemap');
+ my $pointer = App::DocKnot::Spin::Pointer->new({
+ output => '/output',
+ sitemap => $sitemap,
+ });
+ $pointer->spin_pointer('/input/file.spin', '/output/file.html');
+
+=head1 REQUIREMENTS
+
+Perl 5.24 or later and the modules File::ShareDir, Kwalify, List::SomeUtils,
+Pod::Thread, and YAML::XS, all of which are available from CPAN.
+
+=head1 DESCRIPTION
+
+The tree of input files for App::DocKnot::Spin may contain pointers to
+external files in various formats. These files are in YAML format and end in
+C<.spin>. This module processes those files and converts them to HTML and, if
+so configured, adds the links to integrate the page with the rest of the site.
+
+For the details of the pointer file format, see L<POINTER FILES> below.
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item new(ARGS)
+
+Create a new App::DocKnot::Spin::Pointer object. A single converter object
+can be used repeatedly to convert pointers in a tree of files. ARGS should
+be a hash reference with one or more of the following keys, all of which are
+optional:
+
+=over 4
+
+=item output
+
+The path to the root of the output tree when converting a tree of files. This
+will be used to calculate relative path names for generating inter-page links
+using the provided C<sitemap> argument. If C<sitemap> is given, this option
+should also always be given.
+
+=item sitemap
+
+An App::DocKnot::Spin::Sitemap object. This will be used to create inter-page
+links. For inter-page links, the C<output> argument must also be provided.
+
+=item style-url
+
+The base URL for style sheets. A style sheet specified in a pointer file will
+be considered to be relative to this URL and this URL will be prepended to it.
+If this option is not given, the name of the style sheet will be used verbatim
+as its URL, except with C<.css> appended.
+
+=item thread
+
+An App::DocKnot::Spin::Thread object, used for converting POD into HTML. It
+should be configured with the same App::DocKnot::Spin::Sitemap object as the
+C<sitemap> argument.
+
+=back
+
+=back
+
+=head1 INSTANCE METHODS
+
+=over 4
+
+=item is_out_of_date(POINTER, OUTPUT)
+
+Returns true if OUTPUT is missing or if it was modified less recently than the
+modification time of either POINTER or the underlying file that it points to.
+
+=item spin_pointer(POINTER, OUTPUT)
+
+Convert a single pointer file to HTML. POINTER is the path to the pointer
+file, and OUTPUT is the path to where to write the output.
+
+=back
+
+=head1 POINTER FILES
+
+A pointer file is a YAML file ending in C<.spin> that points to the source
+file for a generated HTML page and provides additional configuration for its
+conversion. The valid keys for a pointer file are:
+
+=over 4
+
+=item format
+
+The format of the source file. Supported values are C<markdown> and C<pod>.
+Required.
+
+=item path
+
+The path to the source file. It may be relative, in which case it's relative
+to the pointer file. Required.
+
+=item options
+
+Additional options that control the conversion to HTML. These will be
+different for each supported format.
+
+C<markdown> has no supported options.
+
+The supported options for a format of C<pod> are:
+
+=over 4
+
+=item contents
+
+Boolean saying whether to generate a table of contents. The default is false.
+
+=item navbar
+
+Boolean saying whether to generate a navigation bar at the top of the page.
+The default is true.
+
+=back
+
+=item style
+
+The style sheet to use for the converted output. Optional. If not set,
+converted C<markdown> output will be unstyled and converted C<pod> output will
+use a style sheet named C<pod>.
+
+=item title
+
+The title of the converted page. Optional. If not set, the title will be
+taken from the converted file in a format-specific way. For Markdown, the
+title will be the contents of the first top-level heading. For POD, the title
+will be taken from a NAME section formatted according to the conventions for
+manual pages.
+
+=back
+
+=head1 AUTHOR
+
+Russ Allbery <rra@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2021 Russ Allbery <rra@cpan.org>
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+
+=head1 SEE ALSO
+
+L<docknot(1)>, L<App::DocKnot::Spin>, L<App::DocKnot::Spin::Sitemap>
+
+This module is part of the App-DocKnot distribution. The current version of
+DocKnot is available from CPAN, or directly from its web site at
+L<https://www.eyrie.org/~eagle/software/docknot/>.
+
+=cut
+
+# Local Variables:
+# copyright-at-end-flag: t
diff --git a/lib/App/DocKnot/Spin/RSS.pm b/lib/App/DocKnot/Spin/RSS.pm
index 7599426..2a7460a 100644
--- a/lib/App/DocKnot/Spin/RSS.pm
+++ b/lib/App/DocKnot/Spin/RSS.pm
@@ -9,7 +9,7 @@
# Modules and declarations
##############################################################################
-package App::DocKnot::Spin::RSS 5.00;
+package App::DocKnot::Spin::RSS 6.00;
use 5.024;
use autodie;
@@ -17,7 +17,9 @@ use warnings;
use App::DocKnot;
use App::DocKnot::Spin::Thread;
+use App::DocKnot::Util qw(print_checked print_fh);
use Cwd qw(getcwd);
+use Date::Language ();
use Date::Parse qw(str2time);
use File::Basename qw(fileparse);
use Perl6::Slurp qw(slurp);
@@ -27,30 +29,6 @@ use POSIX qw(strftime);
# Utility functions
##############################################################################
-# print with error checking. autodie unfortunately can't help us because
-# print can't be prototyped and hence can't be overridden.
-sub _print_checked {
- my (@args) = @_;
- print @args or croak('print failed');
- return;
-}
-
-# print with error checking and an explicit file handle. autodie
-# unfortunately can't help us because print can't be prototyped and hence
-# can't be overridden.
-#
-# $fh - Output file handle
-# $file - File name for error reporting
-# @args - Remaining arguments to print
-#
-# Returns: undef
-# Throws: Text exception on output failure
-sub _print_fh {
- my ($fh, $file, @args) = @_;
- print {$fh} @args or croak("cannot write to $file: $!");
- return;
-}
-
# Escapes &, <, and > characters for HTML or XML output.
#
# $string - Input string
@@ -154,7 +132,7 @@ sub _relative_url {
sub _spin_file {
my ($self, $file) = @_;
my $source = slurp($file);
- my $cwd = getcwd();
+ my $cwd = getcwd();
my (undef, $dir) = fileparse($file);
chdir($dir);
my $page = $self->{spin}->spin_thread($source);
@@ -174,7 +152,7 @@ sub _spin_file {
sub _read_rfc2822_file {
my ($self, $file) = @_;
my $key;
- my @blocks = ({});
+ my @blocks = ({});
my $current = $blocks[0];
# Parse the file. $key holds the last key seen, used to append
@@ -405,15 +383,16 @@ sub _rss_output {
# Determine the current date and latest publication date of all of the
# entries, published in the obnoxious format used by RSS.
+ my $lang = Date::Language->new('English');
my $format = '%a, %d %b %Y %H:%M:%S %z';
- my $now = strftime($format, localtime());
+ my $now = $lang->strftime($format, [localtime()]);
my $latest = $now;
if ($entries_ref->@*) {
$latest = strftime($format, localtime($entries_ref->[0]{date}));
}
# Output the RSS header.
- _print_fh($fh, $file, <<"EOC");
+ print_fh($fh, $file, <<"EOC");
<?xml version="1.0" encoding="UTF-8"?>
<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom">
<channel>
@@ -428,18 +407,18 @@ EOC
if ($metadata_ref->{'rss-base'}) {
my ($name) = fileparse($file);
my $url = $metadata_ref->{'rss-base'} . $name;
- _print_fh(
+ print_fh(
$fh,
$file,
qq{ <atom:link href="$url" rel="self"\n},
qq{ type="application/rss+xml" />\n},
);
}
- _print_fh($fh, $file, "\n");
+ print_fh($fh, $file, "\n");
# Output each entry, formatting the contents of the entry as we go.
for my $entry_ref ($entries_ref->@*) {
- my $date = strftime($format, localtime($entry_ref->{date}));
+ my $date = $lang->strftime($format, [localtime($entry_ref->{date})]);
my $title = _escape($entry_ref->{title});
my $description;
if ($entry_ref->{description}) {
@@ -468,7 +447,7 @@ EOC
}
# Output the entry.
- _print_fh(
+ print_fh(
$fh,
$file,
" <item>\n",
@@ -484,7 +463,7 @@ EOC
}
# Close the RSS structure.
- _print_fh($fh, $file, " </channel>\n</rss>\n");
+ print_fh($fh, $file, " </channel>\n</rss>\n");
return;
}
@@ -503,9 +482,9 @@ sub _thread_output {
# Page prefix.
if ($metadata_ref->{'thread-prefix'}) {
- _print_fh($fh, $file, $metadata_ref->{'thread-prefix'}, "\n");
+ print_fh($fh, $file, $metadata_ref->{'thread-prefix'}, "\n");
} else {
- _print_fh(
+ print_fh(
$fh,
$file,
"\\heading[Recent Changes][indent]\n\n",
@@ -520,13 +499,13 @@ sub _thread_output {
# Put headings before each month.
if (!$last_month || $month ne $last_month) {
- _print_fh($fh, $file, "\\h2[$month]\n\n");
+ print_fh($fh, $file, "\\h2[$month]\n\n");
$last_month = $month;
}
# Format each entry.
my $date = strftime('%Y-%m-%d', localtime($entry_ref->{date}));
- _print_fh(
+ print_fh(
$fh,
$file,
"\\desc[$date \\entity[mdash]\n",
@@ -536,11 +515,11 @@ sub _thread_output {
my $description = $entry_ref->{description};
$description =~ s{ ^ }{ }xmsg;
$description =~ s{ \\ }{\\\\}xmsg;
- _print_fh($fh, $file, $description, "]\n\n");
+ print_fh($fh, $file, $description, "]\n\n");
}
# Print out the end of the page.
- _print_fh($fh, $file, "\\signature\n");
+ print_fh($fh, $file, "\\signature\n");
return;
}
@@ -649,14 +628,14 @@ sub _index_output {
# Output the prefix.
if ($metadata_ref->{'index-prefix'}) {
- _print_fh($fh, $file, $metadata_ref->{'index-prefix'}, "\n");
+ print_fh($fh, $file, $metadata_ref->{'index-prefix'}, "\n");
}
# Output each entry.
for my $entry_ref ($entries_ref->@*) {
my @time = localtime($entry_ref->{date});
my $date = strftime('%Y-%m-%d %H:%M', @time);
- my $day = strftime('%Y-%m-%d', @time);
+ my $day = strftime('%Y-%m-%d', @time);
# Get the text of the entry.
my $text;
@@ -679,7 +658,7 @@ sub _index_output {
}{$1 . _relative_url($2, $metadata_ref->{'index-base'}) . ']' }xmsge;
# Print out the entry.
- _print_fh(
+ print_fh(
$fh,
$file,
"\\h2[$day: $entry_ref->{title}]\n\n",
@@ -692,9 +671,9 @@ sub _index_output {
# Print out the end of the page.
if ($metadata_ref->{'index-suffix'}) {
- _print_fh($fh, $file, $metadata_ref->{'index-suffix'}, "\n");
+ print_fh($fh, $file, $metadata_ref->{'index-suffix'}, "\n");
}
- _print_fh($fh, $file, "\\signature\n");
+ print_fh($fh, $file, "\\signature\n");
return;
}
@@ -764,7 +743,7 @@ sub generate {
# Write the output.
if ($format eq 'thread') {
- _print_checked("Generating thread file $prettyfile\n");
+ print_checked("Generating thread file $prettyfile\n");
open(my $fh, '>', $path);
$self->_thread_output($fh, $path, $metadata_ref, \@entries);
close($fh);
@@ -772,7 +751,7 @@ sub generate {
if (scalar(@entries) > $metadata_ref->{recent}) {
splice(@entries, $metadata_ref->{recent});
}
- _print_checked("Generating RSS file $prettyfile\n");
+ print_checked("Generating RSS file $prettyfile\n");
open(my $fh, '>', $path);
$self->_rss_output($fh, $path, $metadata_ref, \@entries);
close($fh);
@@ -780,7 +759,7 @@ sub generate {
if (scalar(@entries) > $metadata_ref->{recent}) {
splice(@entries, $metadata_ref->{recent});
}
- _print_checked("Generating index file $prettyfile\n");
+ print_checked("Generating index file $prettyfile\n");
open(my $fh, '>', $path);
$self->_index_output($fh, $path, $metadata_ref, \@entries);
close($fh);
@@ -813,8 +792,9 @@ App::DocKnot::Spin::RSS - Generate RSS and thread from a feed description file
=head1 REQUIREMENTS
-Perl 5.006 or later and the modules Date::Parse (part of the TimeDate
-distribution) and Perl6::Slurp, both of which are available from CPAN.
+Perl 5.006 or later and the modules Date::Language, Date::Parse (both part of
+the TimeDate distribution), List::SomeUtils, and Perl6::Slurp, both of which
+are available from CPAN.
=head1 DESCRIPTION
diff --git a/lib/App/DocKnot/Spin/Sitemap.pm b/lib/App/DocKnot/Spin/Sitemap.pm
index 038cc9f..22fbdd5 100644
--- a/lib/App/DocKnot/Spin/Sitemap.pm
+++ b/lib/App/DocKnot/Spin/Sitemap.pm
@@ -12,7 +12,7 @@
# Modules and declarations
##############################################################################
-package App::DocKnot::Spin::Sitemap 5.00;
+package App::DocKnot::Spin::Sitemap 6.00;
use 5.024;
use autodie;
@@ -141,7 +141,7 @@ sub _escape {
sub _relative {
my ($origin, $dest) = @_;
my @origin = split(qr{ / }xms, $origin, -1);
- my @dest = split(qr{ / }xms, $dest, -1);
+ my @dest = split(qr{ / }xms, $dest, -1);
# Remove the common prefix.
while (@origin && @dest && $origin[0] eq $dest[0]) {
@@ -207,11 +207,13 @@ sub new {
# links maps partial URLs to a list of other partial URLs (previous, next,
# and then the full upwards hierarchy to the top of the site) used for
# interpage links.
+ #<<<
my $self = {
links => {},
pagedesc => {},
sitemap => [],
};
+ #>>>
bless($self, $class);
# Parse the file into the newly-created object.
@@ -292,7 +294,7 @@ sub navbar {
# Construct the bread crumbs for the page hierarchy.
my @breadcrumbs = (" <td>\n");
- my $first = 1;
+ my $first = 1;
for my $parent (reverse(@parents)) {
my ($url, $desc) = $parent->@*;
my $prefix = q{ } x 4;
@@ -312,7 +314,6 @@ sub navbar {
@breadcrumbs,
$next_link,
"</tr></table>\n",
- "\n",
);
}
@@ -335,7 +336,7 @@ sub sitemap {
# Open or close <ul> elements as needed by the indentation.
if ($indent > $indents[-1]) {
- push(@output, (q{ } x $indent) . "<ul>\n");
+ push(@output, (q{ } x $indent) . "<ul>\n");
push(@indents, $indent);
} else {
while ($indent < $indents[-1]) {
diff --git a/lib/App/DocKnot/Spin/Thread.pm b/lib/App/DocKnot/Spin/Thread.pm
index 492666d..bf58dc0 100644
--- a/lib/App/DocKnot/Spin/Thread.pm
+++ b/lib/App/DocKnot/Spin/Thread.pm
@@ -9,18 +9,20 @@
# Modules and declarations
##############################################################################
-package App::DocKnot::Spin::Thread 5.00;
+package App::DocKnot::Spin::Thread 6.00;
use 5.024;
use autodie;
use warnings;
use App::DocKnot;
+use App::DocKnot::Util qw(print_fh);
use Cwd qw(getcwd realpath);
use File::Basename qw(fileparse);
-use File::Spec ();
+use File::Spec ();
use Git::Repository ();
use Image::Size qw(html_imgsize);
+use Path::Tiny qw(path);
use Perl6::Slurp qw(slurp);
use POSIX qw(strftime);
use Text::Balanced qw(extract_bracketed);
@@ -34,6 +36,7 @@ my $URL = 'https://www.eyrie.org/~eagle/software/web/';
# 1. Number of arguments or -1 to consume as many arguments as it can find.
# 2. Name of the method to call with the arguments and (if wanted) format.
# 3. Whether to look for a format in parens before the arguments.
+#<<<
my %COMMANDS = (
# name args method want_format
block => [1, '_cmd_block', 1],
@@ -80,6 +83,7 @@ my %COMMANDS = (
q{==} => [3, '_define_macro', 0],
q{\\} => [0, '_literal', 0],
);
+#>>>
##############################################################################
# Input and output
@@ -104,22 +108,6 @@ sub _read_file {
return $text;
}
-# print with error checking and an explicit file handle. autodie
-# unfortunately can't help us because print can't be prototyped and hence
-# can't be overridden.
-#
-# $fh - Output file handle
-# $file - File name for error reporting
-# @args - Remaining arguments to print
-#
-# Returns: undef
-# Throws: Text exception on output failure
-sub _print_fh {
- my ($fh, $file, @args) = @_;
- print {$fh} @args or croak("cannot write to $file: $!");
- return;
-}
-
# Sends something to the output file with special handling of whitespace for
# more readable HTML output.
#
@@ -159,7 +147,7 @@ sub _output {
}
# Send the results to the output file.
- _print_fh($self->{out_fh}, $self->{out_path}, $output);
+ print_fh($self->{out_fh}, $self->{out_path}, $output);
return;
}
@@ -255,7 +243,7 @@ sub _paragraph {
# Returns: Output to write to start the structure
sub _border_start {
my ($self, $border, $start, $end) = @_;
- my $state = $self->{state}[-1];
+ my $state = $self->{state}[-1];
my $output = q{};
# If we're at the top-level block structure or inside a structure other
@@ -450,7 +438,7 @@ sub _expand {
my ($blocktag, $output) = $self->$handler($format, @args);
return ($output, $blocktag, $rest);
} else {
- my ($rest, @args) = $self->_extract($text, $args);
+ my ($rest, @args) = $self->_extract($text, $args);
my ($blocktag, $output) = $self->$handler(@args);
return ($output, $blocktag, $rest);
}
@@ -577,7 +565,7 @@ sub _parse_context {
if ($blocktag) {
if ($block && $paragraph ne q{}) {
$output .= $border . $self->_paragraph($paragraph);
- $border = q{};
+ $border = q{};
$paragraph = q{};
} else {
$output .= $space;
@@ -648,25 +636,29 @@ sub _parse {
# since thread may contain relative paths to files that the spinning process
# needs to access.
#
-# $thread - Thread to spin
-# $in_path - Input file path if any, used for error reporting
-# $out_fh - Output file handle to which to write the HTML
-# $out_path - Optional output file path for error reporting and page links
+# $thread - Thread to spin
+# $in_path - Input file path if any, used for error reporting
+# $out_fh - Output file handle to which to write the HTML
+# $out_path - Optional output file path for error reporting and page links
+# $input_type - Optional one-word description of input type
sub _parse_document {
- my ($self, $thread, $in_path, $out_fh, $out_path) = @_;
+ my ($self, $thread, $in_path, $out_fh, $out_path, $input_type) = @_;
# Parse the thread into paragraphs and reverse them to form a stack.
my @input = reverse($self->_split_paragraphs($thread));
# Initialize object state for a new document.
- $self->{input} = [[\@input, $in_path, 1]];
- $self->{macro} = {};
- $self->{out_fh} = $out_fh;
- $self->{out_path} = $out_path // q{-};
- $self->{rss} = [];
- $self->{space} = q{};
- $self->{state} = ['BLOCK'];
- $self->{variable} = {};
+ #<<<
+ $self->{input} = [[\@input, $in_path, 1]];
+ $self->{input_type} = $input_type // 'thread';
+ $self->{macro} = {};
+ $self->{out_fh} = $out_fh;
+ $self->{out_path} = $out_path // q{-};
+ $self->{rss} = [];
+ $self->{space} = q{};
+ $self->{state} = ['BLOCK'];
+ $self->{variable} = {};
+ #>>>
# Parse the thread file a paragraph at a time. _split_paragraphs takes
# care of ensuring that each paragraph contains the complete value of a
@@ -688,7 +680,7 @@ sub _parse_document {
}
# Close open tags and print any deferred whitespace.
- _print_fh($out_fh, $out_path, $self->_block_end(), $self->{space});
+ print_fh($out_fh, $out_path, $self->_block_end(), $self->{space});
return;
}
@@ -735,13 +727,13 @@ sub _split_paragraphs {
# Pull paragraphs off the text one by one.
while ($text ne q{} && $text =~ s{ \A ( .*? (?: \n\n+ | \s*\z ) )}{}xms) {
- my $para = $1;
- my $open_count = ($para =~ tr{\[}{});
+ my $para = $1;
+ my $open_count = ($para =~ tr{\[}{});
my $close_count = ($para =~ tr{\]}{});
while ($text ne q{} && $open_count > $close_count) {
if ($text =~ s{ \A ( .*? (?: \n\n+ | \s*\z ) )}{}xms) {
my $extra = $1;
- $open_count += ($extra =~ tr{\[}{});
+ $open_count += ($extra =~ tr{\[}{});
$close_count += ($extra =~ tr{\]}{});
$para .= $extra;
} else {
@@ -784,7 +776,7 @@ sub _block {
# Close the tag. The tag may have contained attributes, which aren't
# allowed in the closing tag.
- $tag =~ s{ [ ] .* }{}xms;
+ $tag =~ s{ [ ] .* }{}xms;
$output =~ s{ \s* \z }{</$tag>}xms;
if ($format ne 'packed') {
$output .= "\n";
@@ -930,6 +922,7 @@ sub _literal { return (0, q{\\}) }
##############################################################################
# Basic inline commands.
+#<<<
sub _cmd_break { return (0, '<br />') }
sub _cmd_bold { my ($self, @a) = @_; return $self->_inline('b', @a) }
sub _cmd_cite { my ($self, @a) = @_; return $self->_inline('cite', @a) }
@@ -942,6 +935,7 @@ sub _cmd_strong { my ($self, @a) = @_; return $self->_inline('strong', @a) }
sub _cmd_sub { my ($self, @a) = @_; return $self->_inline('sub', @a) }
sub _cmd_sup { my ($self, @a) = @_; return $self->_inline('sup', @a) }
sub _cmd_under { my ($self, @a) = @_; return $self->_inline('u', @a) }
+#>>>
# The headings.
sub _cmd_h1 { my ($self, @a) = @_; return $self->_heading(1, @a); }
@@ -990,8 +984,8 @@ sub _cmd_desc {
my ($self, $format, $heading, $text) = @_;
$heading = $self->_parse($heading);
my $format_attr = $self->_format_attr($format);
- my $border = $self->_border_start('desc', "<dl>\n", "</dl>\n\n");
- my $initial = $border . "<dt$format_attr>" . $heading . "</dt>\n";
+ my $border = $self->_border_start('desc', "<dl>\n", "</dl>\n\n");
+ my $initial = $border . "<dt$format_attr>" . $heading . "</dt>\n";
return $self->_block('dd', $initial, $format, $text);
}
@@ -1099,7 +1093,7 @@ sub _cmd_heading {
sub _cmd_image {
my ($self, $format, $image, $text) = @_;
$image = $self->_parse($image);
- $text = $self->_parse($text);
+ $text = $self->_parse($text);
# Determine the size attributes of the image if possible.
my $size = -e $image ? q{ } . lc(html_imgsize($image)) : q{};
@@ -1117,7 +1111,7 @@ sub _cmd_include {
$file = realpath($self->_parse($file));
# Read the thread, split it on paragraphs, and reverse it to make a stack.
- my $thread = $self->_read_file($file);
+ my $thread = $self->_read_file($file);
my @paragraphs = reverse($self->_split_paragraphs($thread));
# Add it to the file stack.
@@ -1134,7 +1128,7 @@ sub _cmd_include {
# $text - Anchor text
sub _cmd_link {
my ($self, $format, $url, $text) = @_;
- $url = $self->_parse($url);
+ $url = $self->_parse($url);
$text = $self->_parse($text);
my $format_attr = $self->_format_attr($format);
return (0, qq{<a href="$url"$format_attr>$text</a>});
@@ -1164,7 +1158,7 @@ sub _cmd_pre {
sub _cmd_quote {
my ($self, $format, $quote, $author, $cite) = @_;
$author = $self->_parse($author);
- $cite = $self->_parse($cite);
+ $cite = $self->_parse($cite);
my $output = $self->_border_end() . q{<blockquote class="quote">};
# Parse the contents of the quote in a new block context.
@@ -1238,7 +1232,7 @@ sub _cmd_release {
# directly; the RSS feed information is used later in _cmd_heading.
sub _cmd_rss {
my ($self, $url, $title) = @_;
- $url = $self->_parse($url);
+ $url = $self->_parse($url);
$title = $self->_parse($title);
push($self->{rss}->@*, [$url, $title]);
return (1, q{});
@@ -1251,9 +1245,9 @@ sub _cmd_signature {
my $source = $self->{input}[-1][1];
my $output = $self->_border_end();
- # If we're spinning from standard input, don't add any of the standard
- # footer, just close the HTML tags.
- if ($self->{input}[-1][1] eq q{-}) {
+ # If we're spinning from standard input to standard output, don't add any
+ # of the standard footer, just close the HTML tags.
+ if ($source eq q{-} && $self->{out_path} eq q{-}) {
$output .= "</body>\n</html>\n";
return (1, $output);
}
@@ -1262,27 +1256,33 @@ sub _cmd_signature {
if ($self->{sitemap} && $self->{output}) {
my $page = $self->{out_path};
$page =~ s{ \A \Q$self->{output}\E }{}xms;
- $output .= join(q{}, $self->{sitemap}->navbar($page));
+ $output .= join(q{}, $self->{sitemap}->navbar($page)) . "\n";
}
# Figure out the modification dates. Use the Git repository if available.
- my $now = strftime('%Y-%m-%d', gmtime());
- my $modified = strftime('%Y-%m-%d', gmtime((stat($source))[9]));
+ my $now = strftime('%Y-%m-%d', gmtime());
+ my $modified = $now;
+ if ($source ne q{-}) {
+ $modified = strftime('%Y-%m-%d', gmtime((stat($source))[9]));
+ }
if ($self->{repository} && $self->{source}) {
- my $repository = $self->{repository};
- $modified = $repository->run('log', '-1', '--format=%ct', $source);
- if ($modified) {
- $modified = strftime('%Y-%m-%d', gmtime($modified));
+ if (path($self->{source})->subsumes(path($source))) {
+ my $repository = $self->{repository};
+ $modified = $repository->run('log', '-1', '--format=%ct', $source);
+ if ($modified) {
+ $modified = strftime('%Y-%m-%d', gmtime($modified));
+ }
}
}
# Determine which template to use and substitute in the appropriate times.
- $output .= "<address>\n" . q{ } x 4;
+ $output .= "<address>\n";
my $link = qq{<a href="$URL">spun</a>};
if ($modified eq $now) {
- $output .= "Last modified and\n $link $modified\n";
+ $output .= " Last modified and\n $link $modified\n";
} else {
- $output .= "Last $link\n $now from thread modified $modified\n";
+ $output .= " Last $link\n";
+ $output .= " $now from $self->{input_type} modified $modified\n";
}
# Close out the document.
@@ -1306,7 +1306,7 @@ sub _cmd_size {
# Format the size using SI units.
my @suffixes = qw(K M G T);
- my $suffix = q{};
+ my $suffix = q{};
while ($size > 1024 && @suffixes) {
$size /= 1024;
$suffix = shift(@suffixes);
@@ -1410,6 +1410,7 @@ sub new {
}
# Create and return the object.
+ #<<<
my $self = {
output => $args_ref->{output},
repository => $repository,
@@ -1418,6 +1419,7 @@ sub new {
style_url => $style_url,
versions => $args_ref->{versions},
};
+ #>>>
bless($self, $class);
return $self;
}
@@ -1453,12 +1455,12 @@ sub spin_thread_file {
# ensure that relative file references resolve properly.
if (defined($input)) {
my $path = realpath($input) or die "cannot canonicalize $input: $!\n";
- $input = $path;
+ $input = $path;
$thread = slurp($input);
my (undef, $input_dir) = fileparse($input);
chdir($input_dir);
} else {
- $input = q{-};
+ $input = q{-};
$thread = slurp(\*STDIN);
}
@@ -1482,6 +1484,39 @@ sub spin_thread_file {
return;
}
+# Convert thread to HTML and write it to the given output file. This is used
+# when the thread isn't part of the input tree but instead is intermediate
+# output from some other conversion process.
+#
+# $thread - Thread to spin
+# $input - Original input file (for modification timestamps)
+# $input_type - One-word description of input type for the page footer
+# $output - Output file
+#
+# Returns: Resulting HTML
+sub spin_thread_output {
+ my ($self, $thread, $input, $input_type, $output) = @_;
+
+ # Open the output file.
+ my $out_fh;
+ if (defined($output)) {
+ my $path = realpath($output)
+ or die "cannot canonicalize $output: $!\n";
+ $output = $path;
+ open($out_fh, '>', $output);
+ } else {
+ $output = q{-};
+ open($out_fh, '>&', 'STDOUT');
+ }
+
+ # Do the work.
+ $self->_parse_document($thread, $input, $out_fh, $output, $input_type);
+
+ # Clean up and restore the working directory.
+ close($out_fh);
+ return;
+}
+
##############################################################################
# Module return value and documentation
##############################################################################
@@ -1501,8 +1536,9 @@ App::DocKnot::Spin::Thread - Generate HTML from the macro language thread
use App::DocKnot::Spin::Thread;
+ my $input = 'some thread';
my $thread = App::DocKnot::Spin::Thread->new();
- $thread->spin_file('/path/to/file.th', '/path/to/file.html');
+ my $output = $thread->spin_thread($input);
use App::DocKnot::Spin::Sitemap;
use App::DocKnot::Spin::Versions;
@@ -1515,12 +1551,15 @@ App::DocKnot::Spin::Thread - Generate HTML from the macro language thread
sitemap => $sitemap,
versions => $versions,
});
- $thread->spin_file('/input/file.th', '/output/file.th');
+ $thread->spin_thread_file('/input/file.th', '/output/file.html');
+ $thread->spin_thread_output(
+ $input, '/path/to/file.pod', 'POD', '/output/file.html'
+ );
=head1 REQUIREMENTS
-Perl 5.24 or later and the modules Git::Repository and Image::Size, both of
-which are available from CPAN.
+Perl 5.24 or later and the modules Git::Repository, Image::Size,
+List::SomeUtils, and Path::Tiny, all of which are available from CPAN.
=head1 DESCRIPTION
@@ -1601,6 +1640,16 @@ If OUTPUT is omitted, App::DocKnot::Spin::Thread will not be able to obtain
sitemap information even if a sitemap was provided and therefore will not add
inter-page links.
+=item spin_thread_output(THREAD, INPUT, TYPE[, OUTPUT])
+
+Convert the given thread to HTML, writing the result to OUTPUT. If OUTPUT is
+not given, write the results to standard output. This is like spin_thread()
+but does use sitemap information and adds inter-page links. It should be used
+when the thread input is the result of an intermediate conversion step of a
+known input file. INPUT should be the full path to the original source file,
+used for modification time information. TYPE should be set to a one-word
+description of the format of the input file and is used for the page footer.
+
=back
=head1 THREAD LANGUAGE
diff --git a/lib/App/DocKnot/Spin/Versions.pm b/lib/App/DocKnot/Spin/Versions.pm
index b804b08..679b368 100644
--- a/lib/App/DocKnot/Spin/Versions.pm
+++ b/lib/App/DocKnot/Spin/Versions.pm
@@ -12,7 +12,7 @@
# Modules and declarations
##############################################################################
-package App::DocKnot::Spin::Versions 5.00;
+package App::DocKnot::Spin::Versions 6.00;
use 5.024;
use autodie;
@@ -84,9 +84,9 @@ sub _read_data {
if (!defined($time)) {
die "invalid line $. in $path\n";
}
- @depends = @files;
+ @depends = @files;
$timestamp = _datetime_to_seconds($date, $time, $path);
- $date = strftime('%Y-%m-%d', gmtime($timestamp));
+ $date = strftime('%Y-%m-%d', gmtime($timestamp));
$self->{versions}{$package} = [$version, $date];
}
@@ -120,7 +120,7 @@ sub new {
# Create an empty object.
my $self = {
- depends => {},
+ depends => {},
versions => {},
};
bless($self, $class);
diff --git a/lib/App/DocKnot/Update.pm b/lib/App/DocKnot/Update.pm
index ad8eb4d..5c6a999 100644
--- a/lib/App/DocKnot/Update.pm
+++ b/lib/App/DocKnot/Update.pm
@@ -9,7 +9,7 @@
# Modules and declarations
##############################################################################
-package App::DocKnot::Update 5.00;
+package App::DocKnot::Update 6.00;
use 5.024;
use autodie;
@@ -136,8 +136,8 @@ sub _config_from_json {
eval { $data_ref->{license}{notices} = $self->_load_metadata('notices') };
# Load the standard sections.
- $data_ref->{blurb} = $self->_load_metadata('blurb');
- $data_ref->{description} = $self->_load_metadata('description');
+ $data_ref->{blurb} = $self->_load_metadata('blurb');
+ $data_ref->{description} = $self->_load_metadata('description');
$data_ref->{requirements} = $self->_load_metadata('requirements');
# Load optional information if it exists.
@@ -182,7 +182,7 @@ sub new {
# Create and return the object.
my $self = {
metadata => $metadata,
- output => $args_ref->{output} // 'docs/docknot.yaml',
+ output => $args_ref->{output} // 'docs/docknot.yaml',
};
bless($self, $class);
return $self;
@@ -265,7 +265,7 @@ sub update {
# Check the schema of the resulting file.
my $schema_path = $self->appdata_path('schema/docknot.yaml');
- my $schema_ref = YAML::XS::LoadFile($schema_path);
+ my $schema_ref = YAML::XS::LoadFile($schema_path);
eval { validate($schema_ref, $data_ref) };
if ($@) {
my $errors = $@;
diff --git a/lib/App/DocKnot/Util.pm b/lib/App/DocKnot/Util.pm
new file mode 100644
index 0000000..203d3d3
--- /dev/null
+++ b/lib/App/DocKnot/Util.pm
@@ -0,0 +1,172 @@
+# Shared utility functions for other DocKnot modules.
+#
+# A collection of random utility functions that are used by more than one
+# DocKnot module but don't make sense as App::DocKnot methods.
+#
+# SPDX-License-Identifier: MIT
+
+##############################################################################
+# Modules and declarations
+##############################################################################
+
+package App::DocKnot::Util 6.00;
+
+use 5.024;
+use autodie;
+use warnings;
+
+use Carp qw(croak);
+use Exporter qw(import);
+use List::SomeUtils qw(all);
+
+our @EXPORT_OK = qw(is_newer print_checked print_fh);
+
+##############################################################################
+# Public interface
+##############################################################################
+
+# Check if a file, which may not exist, is newer than another list of files.
+#
+# $file - File whose timestamp to compare
+# @others - Other files to compare against
+#
+# Returns: True if $file exists and is newer than @others, false otherwise
+sub is_newer {
+ my ($file, @others) = @_;
+ return if !-e $file;
+ my $file_mtime = (stat($file))[9];
+ my @others_mtimes = map { (stat)[9] } @others;
+ return all { $file_mtime >= $_ } @others_mtimes;
+}
+
+# print with error checking. autodie unfortunately can't help us because
+# print can't be prototyped and hence can't be overridden.
+#
+# @args - Arguments to print to stdout
+#
+# Returns: undef
+# Throws: Text exception on output failure
+sub print_checked {
+ my (@args) = @_;
+ print @args or croak('print failed');
+ return;
+}
+
+# print with error checking and an explicit file handle. autodie
+# unfortunately can't help us because print can't be prototyped and
+# hence can't be overridden.
+#
+# $fh - Output file handle
+# $file - File name for error reporting
+# @args - Remaining arguments to print
+#
+# Returns: undef
+# Throws: Text exception on output failure
+sub print_fh {
+ my ($fh, $file, @args) = @_;
+ print {$fh} @args or croak("cannot write to $file: $!");
+ return;
+}
+
+##############################################################################
+# Module return value and documentation
+##############################################################################
+
+1;
+__END__
+
+=for stopwords
+Allbery DocKnot MERCHANTABILITY NONINFRINGEMENT sublicense FH autodie
+
+=head1 NAME
+
+App::DocKnot::Util - Shared utility functions for other DocKnot modules
+
+=head1 SYNOPSIS
+
+ use App::DocKnot::Util qw(is_newer print_checked print_fh);
+
+ print_checked('some stdout output');
+ if (!is_newer('/output', '/input-1', '/input-2')) {
+ open(my $fh, '>', '/output');
+ print_fh($fh, '/output', 'some stuff');
+ close($fh);
+ }
+
+=head1 REQUIREMENTS
+
+Perl 5.24 or later and the List::SomeUtils module, available from CPAN.
+
+=head1 DESCRIPTION
+
+This module collects utility functions used by other App::DocKnot modules. It
+is not really intended for use outside of DocKnot, but these functions can be
+used if desired.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item is_newer(FILE, SOURCE[, SOURCE ...])
+
+Returns a true value if FILE exists and has a last modified time that is newer
+or equal to the last modified times of all SOURCE files, and otherwise returns
+a false value. Used primarily to determine if a given output file is
+up-to-date with respect to its source files.
+
+=item print_checked(ARG[, ARG ...])
+
+The same as print (without a file handle argument), except that it throws a
+text exception on failure as if autodie affected print (which it unfortunately
+doesn't because print cannot be prototyped).
+
+=item print_fh(FH, NAME, DATA[, DATA ...])
+
+Writes the concatenation of the DATA elements (interpreted as scalar strings)
+to the file handle FH. NAME should be the name of the file open as FH, and is
+used for error reporting.
+
+This is mostly equivalent to C<print {fh}> but throws a text exception in the
+event of a failure.
+
+=back
+
+=head1 AUTHOR
+
+Russ Allbery <rra@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 1999-2011, 2013, 2021 Russ Allbery <rra@cpan.org>
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+
+=head1 SEE ALSO
+
+L<App::DocKnot>
+
+This module is part of the App-DocKnot distribution. The current version of
+DocKnot is available from CPAN, or directly from its web site at
+L<https://www.eyrie.org/~eagle/software/docknot/>.
+
+=cut
+
+# Local Variables:
+# copyright-at-end-flag: t
+# End: